-
Fototrend
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
-
Fferi50
Topikgazda
válasz
glocker
#43633
üzenetére
Szia!
Nézd meg a következő makrót, ami az aktív munkalapra másolja a megnyitni kívánt fájl adatait az első sortól kezdődően. Utána a munkalapot egy új excel fájlba menti el, de az eredményt láthatod a munkalapon is. Az elmentett fájlt már megnyithatod.
A makrót egyenlőre egy üres munkafüzetbe másold be egy modulba és mentsd el makróbarátként ezt a munkafüzetedet. (Alt+F11 - Insert menü - Module)Sub beolvaso()Dim fs As Integer, fnev As String, bestr As String, kistr As Variant, x As Long, valjel As Stringx = 1fs = FreeFile()fnev = "C:\Users\user\Downloads\makroteszt\Munka2.csv" ' ide írd a saját fájlod nevétActiveSheet.UsedRange.ClearContents 'kitöröljük ami a lapon vanOpen fnev For Input Access Read As #fsDo While Not EOF(1)Line Input #1, bestrIf x = 1 Then 'megállapítjuk az elválasztó jeletIf InStr(bestr, ";") > 0 Thenvaljel = ";"ElseIf InStr(bestr, vbTab) > 0 Thenvaljel = vbTabElseIf InStr(bestr, ",") > 0 Thenvaljel = ","End IfEnd IfEnd IfIf valjel = "" Then valjel = ";"End Ifkistr = Split(bestr, valjel)Range(Cells(x, 1), Cells(x, UBound(kistr) + 1)).Value = kistrx = x + 1LoopClose #1'A beolvasott fájlt elmentjük xlsx formátumban --ezeket a sorokat ki is törölhetedActiveSheet.Copy 'de akkor magadnak kell menteni a munkalapotActiveWorkbook.SaveAs "C:\Users\user\Downloads\makroteszt\Munka22.xlsx" 'ide írod a saját nevedActiveWorkbook.Close FalseEnd Sub
Természetesen megoldható az is, hogy a beolvasandó fájlt választani lehessen a szokásos módon.
Ha bármi gondod keletkezik, írj, akár priviben is.
Üdv.
Új hozzászólás Aktív témák
- Milyen légkondit a lakásba?
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Monitor hiba topik
- Futás, futópályák
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Milyen okostelefont vegyek?
- Xiaomi 17 Ultra - jó az optikája
- Le Mans Ultimate
- SSD kibeszélő
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- További aktív témák...
- Bioshock 2 Special Edition
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- AZONNAL KÉSZLETRŐL! Intel Core i5 14600K 32GB 6000MHz RAM 2TB Gen4 SSD RTX 5060 8GB FSP 750W
- ÁRGARANCIA!Épített KomPhone i7 14700KF 32/64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
- Bomba ár! Lenovo ThinkPad T480s - i5-8GEN I 8-16GB I 256SSD I 14" FHD I HDMI I Cam I W11 I Gari!
- HP EliteBook 840 G6, G5 14" i5, 8-16GB RAM, SSD, jó akku, számla, 6 hó gar
- Beszámítás! HP Elitebook 8 G1i 14 FHD notebook - Ultra 5 235U 16GB DDR5 256GB SSD Intel IGP W11
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50