Hirdetés
- Send to qBittorrent (with SavePaths): Egy apró Firefox kiegészítő qBittorrenthez
- Ikea PAX gardrób és a pokol logisztikája – egy Ikea-horror igaz története
- -TongFang- Medion Erazer Beast 16 X1 - induló teszt így kora délután..."CB R23"
- Pi-hole és a Telekom Sagemcom F@st 5670 DNS beállítása
- A Magyar Néphadsereg emlékére
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- GoodSpeed: A RAM-válság és annak lehetséges hatásai
- Magga: PLEX: multimédia az egész lakásban
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- D@reeo: Pi-hole és a Telekom Sagemcom F@st 5670 DNS beállítása
- Ketogén étrend
- sziku69: Szólánc.
- [K2]: AnyDesk átverés
-
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
-
ezt a sort
ActiveWorkbook.SaveAs Filename:="SAP_booking.txt", FileFormat:=xlTextmódosítod erre
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "SAP_Booking.txt", FileFormat:=xlTextEz meg egy másik megközelítés, talán van/lesz hasznos dolog a későbbiekben számodra.
Private Sub CommandButton1_Click()
Dim MyWorkBook As Workbook
Dim MySheet As Worksheet
Dim MyRange As Range
Dim MyFilename, TextFileLine As String
Dim MyFirstColumn, MyLastColumn As String
Set MyWorkBook = ThisWorkbook
Set MySheet = Sheets("input")
'Feldolgozandó adatok kezdőcellája
MyFirstColumn = "A4"
'Feldolgozandó adatok utolsó oszlopa
MyLastColumn = "Q"
'Fájlnév megadása, ami az adott Excel munkafüzettel egy könyvtárban kerül létrehozásra
MyFilename = MyWorkBook.Path & "\" & "SAP_Booking.txt"
'Adattartomány meghatározása
Set MyRange = MySheet.Range(MyFirstColumn & _
":" & _
MyLastColumn & _
MySheet.Range(MyLastColumn & Rows.Count).End(xlUp).Row)
'Fájl létrehozása (ha nem létezik létrehozza, ha létezik KÉRDÉS NÉLKÜL felülírja
Open MyFilename For Output As #1
'Végigszaladunk az adattartomány celláin
For i = 1 To MyRange.Rows.Count
'Ha az adattartomány kezdő oszlopában található cella nem üres(ha üres, akkor a sor is üresnek tekindendő),
'akkor feldolgozzuk az adott sorban lévő adatokat
If Not IsEmpty(MyRange.Cells(i, 1)) Then
For j = 1 To MyRange.Columns.Count
'Tabulátorral elválasztott szöveg létrehozása a sor celláinak feldolgozásával
TextFileLine = IIf(j = 1, "", TextFileLine & vbTab) & MyRange.Cells(i, j)
Next j
'Kiírás fájlba
Print #1, TextFileLine
End If
Next i
'Fájl lezárása
Close #1
End Sub -
Fferi50
Topikgazda
Szia!
Próbáld ki ezt a makrót légy szíves:Sub mentes()Sheets("input").ActivateRange(Cells(1, 1), Cells(ActiveSheet.UsedRange.Columns(1).Find(what:="", LookIn:=xlValues, lookat:=xlPart).Row - 1, ActiveSheet.UsedRange.Columns.Count)).CopySheets.AddRange("A1").PasteSpecial Paste:=xlPasteValuesApplication.CutCopyMode = FalseActiveSheet.MoveActiveWorkbook.SaveAs Filename:="SAP_booking.txt", FileFormat:=xlTextActiveWorkbook.Close FalseEnd SubÜdv.
-
Fferi50
Topikgazda
Szia!
Szerintem csak meg kell nézned, hogy az A oszlopban levő cella értéke (a képlet eredménye) nem üres string és ott abbahagyni a kimásolást.
Gondolom valamilyen ciklus végzi a másolást, akkor a következő másolás előtt (For Next ciklus esetén:pl. If Range("A" & sor+1).Value="" Then Exit For
ahol a sor az aktuális sor száma
vagyIf Range("A" & sor).Offset(1,0).Value="" Then Exit For
Más ciklusszervezésnél is hasonló lehet a vizsgálat.
Üdv. -
Látatlanban nehéz segíteni, ezért tisztázzunk pár alap dolgot, hogy így van-e avagy sem.
tehát például:
Excel munkafüzet 1-ben
A1:A30 -> Ezen sorokban (amelyek egyike sem üres) vannak adatok x darab oszlopban
A31 -> üres sor
A32:A62-> Ezen sorokban (amelyek egyike sem üres) vannak adatok x darab oszlopban
A63 -> üres sor
A64:A94-> Ezen sorokban (amelyek egyike sem üres) vannak adatok x darab oszlopban
A95 -> üres sor
és így tovább...Ez így van?
UI: Jobb lenne, ha egy képet dobnál a munkafüzet 1 és munkafüzet 2-ről is, hogy láthassuk, hogy milyen az alapfelépítése a munkafüzet 1-nek, meg mit gyárt le a makró a munkafüzet 2-be... (valami valótlan adatokkal töltsd fel a munkafüzetet, ne a valós személyes adatokat lássuk...)
Új hozzászólás Aktív témák
- X140M1F4N károsultjai
- A fociról könnyedén, egy baráti társaságban
- Genshin Impact (PC, PS4, Android, iOS)
- Milyen okostelefont vegyek?
- Xiaomi 15T - reakció nélkül nincs egyensúly
- Anglia - élmények, tapasztalatok
- AGM G3 Pro - ordít róla, hogy szoftverfejlesztők kellenének
- The Division 2 (PC, XO, PS4)
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- További aktív témák...
- Árváltozás+játék!The Witcher 2 Assassins of Kings Collector's Edition
- PC Game Pass előfizetés
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- BLACK FRIDAY! - Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával
- Telefon felvásárlás!! Apple iPhone 16, Apple iPhone 16e, Apple iPhone 16 Plus, Apple iPhone 16 Pro
- ÁRGARANCIA!Épített KomPhone Ryzen 7 7800X3D 32/64GB RAM RX 7800 XT 16GB GAMER PC termékbeszámítással
- Huawei P30 Lite / 4/128GB / Kártyafüggetlen / 12Hó Garancia
- GYÖNYÖRŰ iPhone 13 mini 128GB Starlight -1 ÉV GARANCIA -Kártyafüggetlen, MS3892, 100% Akkumulátor
- HIBÁTLAN iPhone 15 Plus 128GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS4045, 100% Akkumulátor
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi
Fferi50
