-
Fototrend
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
-
Pakliman
tag
válasz
bozsozso
#49224
üzenetére
Szia!
Egy lehetőség (sok [több ezer!] sor esetén kicsit lassabb):
Az "utvonal" változóba beépíted az AD oszlopban lévő adatot.
Pl.: utvonal = "E:\teszt\" & Cells(i, "AD") & "\".
Ez után APPEND-el megnyitod az abban a mappában lévő "teszt.TXT" fájlt (ha nem létezik még, akkor az APPEND létrehozza!):Open DestFile For Append As #FileNum
Beírod a megfelelő adatokat az ÉPPEN AKTUÁLIS sorból, majd RÖGTÖN LEZÁROD a fájlt!!!:Close FileNum
Az Open előtt természetesen mindigFileNum = FreeFile()Célszerűbb szerintem inkább a For... Next ciklust használni, hiszen ismered az első és utolsó sor számát is.
Sub Próba()
Const sep = ","
Dim utvonal As String
Dim b As String
Dim FileNum As Integer
Dim DestFile As String
Dim vLastRow As Long
Dim ki As String
Dim i As Long, j As Long
vLastRow = Range("AD" & Rows.Count).End(xlUp).Row
For i = 2 To vLastRow
b = Cells(i, "AD")
utvonal = "E:\teszt\" & b & "\"
If Dir(utvonal, vbDirectory) = "" Then MkDir (utvonal)
DestFile = utvonal & "teszt.TXT"
FileNum = FreeFile()
Open DestFile For Append As #FileNum
ki = "7000" & sep & b & "_" & ". stb... amit akarsz..."
Print #FileNum, Left(ki, Len(ki) - Len(sep))
Close FileNum
Next i
End SubA megfelelő mappa létezését pedig a DIR paranccsal tudod ellenőrizni. Ha nem létezik, letrehozod.
Új hozzászólás Aktív témák
- exHWSW - Értünk mindenhez IS
- Lítium-ion/Li-ion akkumulátorok
- Samsung Galaxy Watch5 Pro - kerek, de nem tekerek
- Bittorrent topik
- Mibe tegyem a megtakarításaimat?
- Xiaomi 17 Ultra - jó az optikája
- Racoon City árnyékában: Teszteltük a Resident Evil Requiemet
- Gitáros topic
- Hardcore café
- MWC 2026: Óriásakkut tuszkoltak egy szupervékony hajlíthatóba
- További aktív témák...
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- HIBÁTLAN iPhone 17 Pro Max 256GB Deep Blue-1 ÉV GARANCIA - Kártyafüggetlen, 100% Akksi
- Új DELL Inspiron 14 (5435)/AMD RYZEN 7-7730U/16GB/512 SSD/14"/FHD/IPS/Garancia
- Mini Pc HP ProDesk 600 G2 / G4 / G5 // Lenovo Ttinkcentre M900 // 6-9. gen // i3 / i5
- TP Link HS100 Távolról vezérelhető Wi-Fi-s dugalj (Smart Plug)
- Tablet felvásárlás!! Apple iPad, iPad Mini, iPad Air, iPad Pro
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50