- Apple MacBook
- Házimozi belépő szinten
- Nagyon is lát fantáziát a Socket AM4-ben az ASRock
- Milyen videókártyát?
- Ami Kínában OnePlus Pad Pro, az errefelé mégis csak Pad 2 lett
- Androidos tablet topic
- Azonnali VGA-s kérdések órája
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Véleményes teszt bizonygatja mennyit ér a Macbook Neo 8 GB RAM-ja
- Kormányok / autós szimulátorok topikja
-
PROHARDVER!
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
- Fejhallgatós találkozó
- Apple MacBook
- Házimozi belépő szinten
- Nagyon is lát fantáziát a Socket AM4-ben az ASRock
- Milyen videókártyát?
- PlayStation 5
- Xbox Series X|S
- Ami Kínában OnePlus Pad Pro, az errefelé mégis csak Pad 2 lett
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- EA Sports WRC '23
- További aktív témák...
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- PC Game Pass előfizetés
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- GYÖNYÖRŰ iPhone 14 Pro Max 256GB Space Black-1 ÉV GARANCIA - Kártyafüggetlen, MS4143
- Gigabyte RTX 5070 Ti // Felbontott, új // SZÁMLA // GARANCIA //
- Telefon felvásárlás!! iPhone 12 Mini/iPhone 12/iPhone 12 Pro/iPhone 12 Pro Max
- Apple iPhone 13 128GB, Kártyafüggetlen, 1 Év Garanciával
- iKing.Hu - Apple iPhone 16e 128GB White használt újszerű 100% akku 83 ciklus garanciás 2026.10.26-ig
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
