Hirdetés
- GoodSpeed: Munkaügyi helyzet Hajdú-Biharban: észak és dél
- eBay-es kütyük kis pénzért
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Parci: Milyen mosógépet vegyek?
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- MasterDeeJay: Harc a DDR5 árak ellen
- GoodSpeed: WELLPUR KVITA GF85 - JYSK - tapasztalatok
- sziku69: Szólánc.
- Viber: ingyen telefonálás a mobilodon
-
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
#49244
üzenetére
Jónak tűnik, viszont én egy változóba menteném a régi értéket.
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
Dim mentett As String
vLastRow = Range("AD" & Rows.Count).End(xlUp).Row
'A sorba rendezés
Columns("A:AD").Sort Key1:=Columns("AD"), Header:=xlYes
mentett = ""
bezárni = False
For i = 2 To vLastRow
b = Cells(i, "AD")
If mentett <> b Then
'"Változott" az AD cella értéke, tehát...
If FileNum <> 0 Then Close FileNum '...bezárjuk az előzőleg megnyitott fájlt
mentett = b 'Az új értéket elmentjük
utvonal = "E:\teszt\" & b & "\"
If Dir(utvonal, vbDirectory) = "" Then MkDir (utvonal)
DestFile = utvonal & "teszt.TXT"
FileNum = FreeFile()
Open DestFile For Append As #FileNum
End If
ki = "7000" & sep & b & "_" & ". stb... amit akarsz..."
Print #FileNum, Left(ki, Len(ki) - Len(sep))
Next i
If FileNum <> 0 Then Close FileNum 'A végső lezárás...
End Sub
Új hozzászólás Aktív témák
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most Ünnepi áron! :)
- PC Game Pass előfizetés
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Apple iPhone 15 Pro Max 256 GB Natural Titanium 1 év Garancia Beszámítás Házhozszállítás
- ÁRGARANCIA!Épített KomPhone i5 14600KF 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- Azonnali készpénzes AMD Radeon RX 6000 sorozat videokártya felvásárlás személyesen/csomagküldéssel
- LENOVO Legion Pro 5 16IRX8 - 16" WQXGA 240Hz - i5-13500HX - 16GB - 1TB - RTX 4060 - 9 Hó garancia
- Bomba ár! Lenovo ThinkPad T480 - i5-8G I 8GB I 256-512-1T SSD I 14" FHD I HDMI I Cam I W11 I Gari!
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: ATW Internet Kft.
Város: Budapest
Fferi50
