- Samsung Galaxy A52s 5G - jó S-tehetség
- Samsung Galaxy Z Fold7 - ezt vártuk, de…
- Sony Xperia 1 VII - Látod-e, esteledik
- A Pixel 10 minden színben és oldalról
- Hat év támogatást csomagolt fém házba a OnePlus Nord 4
- Xiaomi Mi 10T Pro - a házon belüli ellenfél
- Samsung Galaxy A54 - türelemjáték
- Milyen okostelefont vegyek?
- Samsung Galaxy Watch7 - kötelező kör
- iPhone topik
Hirdetés
-
Mobilarena
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
válasz
bozsozso #9716 üzenetére
Bocs a megkésett anyagért, de hétköznapokon el vagyok rendesen foglalva.
Ez a kód az összes CSV fájlt feldolgozza illetve AutoFilter-rel látja el. Ebből a táblázatból pedig kényelmesen legyárthatsz kimutatást, abban meg azt és úgy összesíthetsz, ahogy csak szeretnéd.
(Azért tettem be ide PH!-ra, mert hátha mások is találnak benne hasznos dolgokat)Private Sub CommandButton1_Click()
'elválasztó-karakter a CSV fájlokon belül
Const MYDELIMITER = ";"
'hol találhatóak a CSV fájlok
Const MYPATH = "D:\fire\csvs_path\"
'melyik munkalapra legyenek bemásolva az adatok
'(A munkalapnak LÉTEZNIE KELL!)
Dim DestWS As Worksheet
Set DestWS = Worksheets("Munka2")
'a megadott munkalap melyik cellájától kerüljenek be az adatok
Dim DestRange As Range
Set DestRange = DestWS.Range("A1")
Dim MyStr As String
Dim MyStrs() As String
Dim MyFileIndex As Integer
Dim MyRowCount As Integer
Dim MyCount As Integer
Application.ScreenUpdating = False
DestWS.Select
DestWS.UsedRange.Clear
DestRange.Select
MyRowCount = 0
MyFileIndex = 0
MyFname = Dir(MYPATH & "*.csv")
Do While Len(MyFname) > 0
MyFnum = FreeFile
Open MYPATH & MyFname For Input As MyFnum
Line Input #MyFnum, MyStr
Line Input #MyFnum, MyStr
Line Input #MyFnum, MyStr
If MyFileIndex = 0 Then
ActiveCell.Offset(MyRowCount, 0).Value = "TelephelyKód"
MyFileIndex = 1
MyStrs = Split(MyStr, MYDELIMITER)
If Right(MyStr, 1) = MYDELIMITER Then
MyCount = UBound(MyStrs())
Else: MyCount = UBound(MyStrs()) + 1
End If
For i = 0 To MyCount - 1
ActiveCell.Offset(MyRowCount, i + 1).Value = MyStrs(i)
Next i
MyRowCount = MyRowCount + 1
End If
Line Input #MyFnum, MyStr
Line Input #MyFnum, MyStr
While Not EOF(MyFnum)
Line Input #MyFnum, MyStr
xstr = Mid(MyFname, InStr(1, MyFname, ".", vbTextCompare) - 3, 3)
ActiveCell.Offset(MyRowCount, 0).Value = xstr
MyStrs = Split(MyStr, MYDELIMITER)
For i = 0 To MyCount - 1
ActiveCell.Offset(MyRowCount, i + 1).Value = Trim(MyStrs(i))
Next i
MyRowCount = MyRowCount + 1
Wend
Close MyFnum
MyFname = Dir()
Loop
With ActiveSheet
.Range(DestRange.Address & ":" & Chr(DestRange.Column + MyCount + 64) & DestRange.Row).AutoFilter
.Columns.AutoFit
End With
Application.ScreenUpdating = True
If MyRowCount = 0 Then MsgBox "A megadott termék nem található az átvizsgált CSV fájlokban.", vbInformation
Set DestWS = Nothing
Set DestRange = Nothing
End Sub -
-
válasz
bozsozso #9710 üzenetére
Akkor ezek lennének a feladatok?
1. Minden CSV első 4 sorának kihagyása
2. Terméknevek alapján létrehozni külön-külön munkalapokat, és abba pakolni a szükséges adatokatEhhez szükségem lenne egy CSV fájlra(ha publikus el is küldheted, ha nem, akkor meg készíts egy CSV kamu adatokkal, illetve erről
"Tehát új munkalap létrehozás majd pl.:a C1 cellába a terméknév utánna pedig pl. az A2-től a cellákban a telephelyek(ami fájlnév utolsó 3 karaktere) és mondjuk a B2 cellától lefelé a mennyiségek."
egy képet tegyél be...Delila_1
Köszönöm, éltetett. Igaz kicsit rövidre sikeredett, de legalább olyan ismerősökkel tudtam pár szót váltani, akikkel évek óta nem találkoztunk... -
-
-
válasz
bozsozso #9698 üzenetére
2 lehetőség van ekkor
1. Nincs 5. elem (MyStrs(4))
2. Nem egyforma formátumúak a CSV-kPuhatold ki melyik, és módosítom, kivitelezhető így és úgy is...
(Ma nem vagyok 100%-os, mivel (és ez lehet infó rólam pár emberkének), de Józsi vagyok és a barátokkal egy kicsit(tényleg kicsit) felöntünk a garatra...Holnap jelentkezem...
UI: Delila_1 tényleg egy "kis" zseni, bele sem merek gondolni, ha összehozott volna minket a sors az életben, milyen hiperkocka gyerkőceink lettek volna...
(Bocsi delila_1, remélem poénnak fogod fel, mert annak szántam) -
válasz
bozsozso #9681 üzenetére
No mindegy, majd kipróbálod, aztán ha valamit módosítani kell, akkor módosítva lesz...
Private Sub CommandButton1_Click()
'elválasztó-karakter a CSV fájlokon belül
Const MYDELIMITER = ";"
'hol találhatóak a CSV fájlok
Const MYPATH = "D:\fire\csvs_path\"
'melyik munkalapra legyenek bemásolva az adatok
Dim DestWB As Worksheet
Set DestWB = Worksheets("Munka2")
'a megadott munkalap melyik cellájától kerüljenek be az adatok
Dim DestRange As Range
Set DestRange = DestWB.Range("A1")
Dim MyStr As String
Dim MyStrs() As String
'meg kell adni, milyen terméket keressünk a CSV fájlok-ban és OK gomb
'Cancel gombbal megszakítható a művelet
UserChange = InputBox("Mit keressünk? (kis- és nagybetű nem számít...)", "Keresés...")
If Len(UserChange) > 0 Then
Application.ScreenUpdating = False
'kiválasszuk a megadott munkalapot
DestWB.Select
'töröljük annak teljes tartalmát
DestWB.UsedRange.Clear
DestRange.Select
MyRowCount = 0
MyFname = Dir(MYPATH & "*.csv")
Do While Len(MyFname) > 0
MyFnum = FreeFile
Open MYPATH & MyFname For Input As MyFnum
While Not EOF(MyFnum)
Line Input #MyFnum, MyStr
MyStrs = Split(MyStr, MYDELIMITER)
'vizsgáljuk, hogy a CSV fájl adott sorában, utolsó eleme után van-e még elválasztókarakter avagy sem
If Right(MyStr, 1) = MYDELIMITER Then
MyCount = UBound(MyStrs())
Else: MyCount = UBound(MyStrs()) + 1
End If
'a MyStrs(0) indexével adjuk meg, hogy a CSV fájlon belül, hányadik elem a termék neve
'első->0, második->1, harmadik->2 stb stb
If UCase(MyStrs(0)) = UCase(UserChange) Then
For i = 0 To MyCount - 1
ActiveCell.Offset(MyRowCount, i).Value = MyStrs(i)
Next i
MyRowCount = MyRowCount + 1
End If
Wend
Close MyFnum
MyFname = Dir()
Loop
Application.ScreenUpdating = True
'ha nem találtunk egyetlen megadott nevű terméket sem, arról értesítést adunk
If MyRowCount = 0 Then MsgBox "A megadott termék nem található az átvizsgált CSV fájlokban.", vbInformation
End If
Set DestWB = Nothing
Set DestRange = Nothing
End Sub -
-
-
válasz
bozsozso #9591 üzenetére
Megnyitod a munkafüzeted, amiben ezt a "furcsa" kerekítést használni szeretnéd, ALT+F11/Insert menü/Module és a megjelenő ablakba bemásolod az általam adott kódot. Mentés másként és makróbarát dokumentumként kell menteni immár.
Az a kód egy függvény, ugyanazok a szabályok érvényesek rá, mint pl a SZUM függvényre, azaz, egy adott cellán állva azt kell beírni, hogy pl =FSCD_Round5_9(A1)
-
perfag
aktív tag
válasz
bozsozso #9593 üzenetére
Előkészület: C2:igen, C3:nem - kijelölöd a cellákat amelyekre adatérvényesítést akarsz
Adatok menü, Adateszközök csoport, Érvényesítés parancs
A párbeszédablakban: Megengedve lenyíló: Lista - Forrásnak kijelölöd a C2:C3-at Ok
Ha akarod cifrázni próbáld ki a másik két fület is, beírsz valamiket és figyelszAz ok végrehajtása után a cellákon lenyíló jel jelenik meg. Lenyitod, kiválasztod. De beírhatsz is, ha elvéted akkor háborog. A háborgó üzenetedet a harmadik fülön magad megadhatod.
Lehet, hogy megint elütöttem valamit? Én radam kérdésére válaszolok éppen.
-
válasz
bozsozso #9584 üzenetére
Az alábbi kód szabályos KEREKÍTÉS-t végez először (5 tizedtől felfelé illetve az alatt lefelé), továbbá most úgy írtam, hogy a kerekítést követően a 2-re végződő számokat 5-re , míg 7-re végződőket 9-re módosítja. Próbáld ki, remélem így megfelel.
Function FSCD_Round5_9(xCell As Range) As Single
Dim xNumber As Single
Dim xStr As String, xChar As String
Dim MyFxs As WorksheetFunction
Set MyFxs = Application.WorksheetFunction
xNumber = xCell
xStr = MyFxs.Round(xNumber, 0)
xNumber = xStr
xChar = Right(xStr, 1)
Select Case xChar
Case "0"
xNumber = xNumber - 1
Case "1"
xNumber = xNumber - 2
Case "2"
xNumber = xNumber + 3
Case "3"
xNumber = xNumber + 2
Case "4"
xNumber = xNumber + 1
Case "5"
Case "6"
xNumber = xNumber - 1
Case "7"
xNumber = xNumber + 2
Case "8"
xNumber = xNumber + 1
Case "9"
End Select
Set MyFxs = Nothing
FSCD_Round5_9 = xNumber
End Function -
-
válasz
bozsozso #9485 üzenetére
=SZUMHA(A1:A4;"#";B1:B4)
Csillagot nem használhatsz, mert az ún. asterix karakter (helyettesítő karakter, mint akár a kérdőjel)
karczt
Az a baj, hogy pl a scroll lock esetén amit leírsz, annak úgy is kell működni.
Alfanumerikus ill. numerikus padon beírva a számot, akkor ugyanaz a helyzet? -
Delila_1
veterán
válasz
bozsozso #9011 üzenetére
Vigyázat! A számolás a megjelenítési formátumtól függetlenül a teljes számmal számol, nemcsak a látható részével. Előfordulhat, hogy az így formázott számok összege látszólag hamis eredményt ad.
Pl. a
364665 és
155723 összege
520388A látványuk
365 és
156, az összegük
520, ami látszólag hamis érték. -
válasz
bozsozso #9004 üzenetére
Basszuskulcs...
Emlékeztem egy nagyon egyszerű megoldásra, de ez valamiért nem akart működni, #,
Szóval egy kereszt és egy sima vessző és ez nem műxik, de megvilágosodtam, ez viszont pöpecül műxik, egyszerű cellaformázás és számolhatsz is vele utána# "e Ft"
Hát ez tényleg szívás volt, egy vesszőt lecseréltem szóközre...
m.zmrzlina
Nálam úgy ahogy leírtad (kötőjellel) nem működik... -
m.zmrzlina
senior tag
válasz
bozsozso #9004 üzenetére
Egyéni formátumkód létrehozásával meg lehet oldani.
Cellák formázása>Szám>Egyéni
Itt kiválasztod akármelyiket és átírod erre:
#-" e"
(a kettős kereszt után kötőjel van és ebben van a lényeg csak itt nem nagyon látszik) 1db kötőjel 1000-rel osztja a beírt számot. Ha milliókkal vagy milliárdokkal számolsz akkor többszörözni lehet a kötőjelet és persze utána "m" vagy "mrd"
Ezzel tudsz számolni is.
-
válasz
bozsozso #9002 üzenetére
"Egyszerű" cellaformázással (a legjobb tudomásom szerint) nem lehet, vagy felveszel egy segédoszlopot és abba beírod pl ezt =A1/1000 & "e Ft" vagy ez esetben elegánsabb és célszerűbb is egy makrót írni, ami figyeli, hogy ha az adott oszlopban/tartományban módosul egy cella tartalma, akkor automatikusan végigszalad az adott oszlopon/tartományon és elvégzi a szükséges formázást.
Természetesen a képlet amit feljebb írtam egy "nyers valami", ha szükséges(és általában az), akkor a kerekítésekről gondoskodni kell.
Új hozzászólás Aktív témák
- Építő/felújító topik
- OLED TV topic
- Peugeot, Citroën topik
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- AMD Ryzen 9 / 7 / 5 7***(X) "Zen 4" (AM5)
- Samsung Galaxy A52s 5G - jó S-tehetség
- Elektromos autók - motorok
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- OLED monitor topic
- Okos Otthon / Smart Home
- További aktív témák...
- Telefon felvásárlás!! iPhone 16/iPhone 16 Plus/iPhone 16 Pro/iPhone 16 Pro Max
- Gyors, Precíz, Megbízható TELEFONSZERVIZ, amire számíthatsz! Akár 1 órán belül
- MacBook felváráslás!! MacBook, MacBook Air, MacBook Pro
- Gamer PC- Számítógép! Csere-Beszámítás! R9 3900X / RX 6700XT 12GB / 32GB DDR4 / 1TB SSD
- 10 GB-os RTX 3080 OEM
Állásajánlatok
Cég: FOTC
Város: Budapest