Hirdetés
- eBay-es kütyük kis pénzért
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- Pötyi: 4. RETRO KONZOL ÉS SZÁMÍTÓGÉP BÖRZE - '25. november 16.
- Brogyi: CTEK akkumulátor töltő és másolatai
- weiss: Lakodalom van a mi utcánkban...
- sziku69: Szólánc.
- laskr99: DFI és DFI Lanparty gyűjteményem
- sh4d0w: Kalózkodás. Kalózkodás?
- Gurulunk, WAZE?!
-
LOGOUT
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
#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 -
Új hozzászólás Aktív témák
- Samsung UE75DU7172U 189 cm / 75 4K UHD Smart TV 6 hó garancia Házhozszállítás
- REFURBISHED - DELL Precision Dual USB-C Thunderbolt Dock - TB18DC
- ÁRGARANCIA!Épített KomPhone i5 10400F 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
- Gamer PC-Számítógép! Csere-Beszámítás! I5 12400F / RTX 3070 8GB / 32GB DDR4 / 1TB SSD
- Samsung Galaxy S21 5G / 8/128GB / Kártyafüggetlen / 12Hó Garancia /
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50
