Hirdetés
- Zolii21: 2HB Informatika - Ernő vélemények
- bobalazs: i5 4690 + RX 460 HTPC
- MasterDeeJay: Egy nem átlagos Asus videókártya (GTX950M 2GB GDDR3)
- Magga: PLEX: multimédia az egész lakásban
- gban: Ingyen kellene, de tegnapra
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Luck Dragon: Asszociációs játék. :)
- Négymagos Xeon(!) CPU LGA775-ös deszkában
- hmzs: Fujitsu Futro S920 csúcsra járatva
- gerner1
-
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
-
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
- Házi barkács, gányolás, tákolás, megdöbbentő gépek!
- PlayStation 5
- Yettel topik
- Temu
- TCL LCD és LED TV-k
- Nintendo Switch 2
- Marathon: érkezik a duó, egyelőre csak egy pályán és „kísérleti” jelleggel
- Eredeti játékok OFF topik
- Autós kamerák
- Nem követi az NVIDIA dupla pontosságra kialakított modelljét az AMD
- További aktív témák...
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Microsoft és egyéb dobozos retro szoftverek
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- PC Játékok
- AKCIÓ! Sony Playstation 5 PRO 2TB Digital játékkonzol garanciával extrákkal hibátlan működéssel
- Samsung Galaxy Xcover 5 64GB, Kártyafüggetlen, 1 Év Garanciával
- HIBÁTLAN iPhone 15 Pro 128GB Natural Titanium -1 ÉV GARANCIA - Kártyafüggetlen, MS4401
- MikroTik RB5009UPr+S+IN
- LG 32UN880K - 32" IPS ERGO / 4K UHD / 60Hz 5ms / DisplayHDR 400 / USB Type-C / AMD FreeSync
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50