Hirdetés
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Magga: PLEX: multimédia az egész lakásban
- GoodSpeed: Te hány éves vagy?
- Luck Dragon: Alza kuponok – aktuális kedvezmények, tippek és tapasztalatok (külön igényre)
- sziku69: Szólánc.
- laskr99: Processzor és videokártya szilícium mag fotók újratöltve!
- gban: Ingyen kellene, de tegnapra
- vrob: Próbálkozás 386 alaplap újraélesztésre
- Luck Dragon: Asszociációs játék. :)
- ldave: New Game Blitz - 2026
-
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
- HiFi műszaki szemmel - sztereó hangrendszerek
- CES 2026: nagy újítást hoz az érkező AMD EPYC
- Google Pixel 9 Pro XL - hét szűk esztendő
- Okos Otthon / Smart Home
- OnePlus 15 - van plusz energia
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Kamionok, fuvarozás, logisztika topik
- Víz- gáz- és fűtésszerelés
- Magga: PLEX: multimédia az egész lakásban
- Szünetmentes tápegységek (UPS)
- További aktív témák...
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- BESZÁMÍTÁS! ASUS ROG Crosshair VIII Extreme alaplap garanciával hibátlan működéssel
- Xiaomi 14T 25,Újszerű,Dobozával,12 hónap garanciával
- GYÖNYÖRŰ iPhone 14 Pro 128GB Deep Purple-1 ÉV GARANCIA - Kártyafüggetlen, MS4237,100% Akksi
- Sanyo akkutöltő + 2 használható akku
- Sima Vs.Windows Logitech Mx keys s plus és hagyományos Mx keys magyar bemutatása. Új videó linkkel
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest
Fferi50
