-
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
- Multimédiás / PC-s hangfalszettek (2.0, 2.1, 5.1)
- Kerékpárosok, bringások ide!
- Az 5 legnagyobb bénázás a mobilpiacon idén
- Anglia - élmények, tapasztalatok
- Milyen hagyományos (nem okos-) telefont vegyek?
- AMD Navi Radeon™ RX 9xxx sorozat
- Youtube Android alkalmazás alternatívák reklámszűréssel / videók letöltése
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Intel Dual Core 2000 felhasználók barátságos offolós topikja
- Bittorrent topik
- További aktív témák...
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most Ünnepi áron! :)
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Apple iPhone 15 128GB, Kártyafüggetlen, 1 Év Garanciával
- Telefon felvásárlás!! Xiaomi Redmi 9, Xiaomi Redmi 9AT, Xiaomi Redmi 10, Xiaomi Redmi 10 2022
- HIBÁTLAN iPhone 12 mini 128GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS3303
- DELL PowerEdge R740 rack szerver - 2xGold 6130 (16c/32t, 2.1/3.7GHz), 64GB RAM, 10Gbit HBA330, áfás
- ÁRGARANCIA!Épített KomPhone i5 14400F 16/32/64GB RAM RX 9060 XT 16GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopszaki Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Fferi50
