Text Art

Szövegfájlok importálása

Egy szöveges állomány – például .txt vagy .csv kiterjesztésű fájl – beimportálása az Excelbe makró nélkül sem egy bonyolult mutatvány. Ha rendszeresen azonos struktúrájú szövegfájlokat kell beimportálnunk, akkor egy rövid programkóddal egyszerűen automatizálhatjuk ezt a tevékenységet. Mindez addig igaz, amíg a szövegfájl struktúrája megegyezik azzal a struktúrával, amit az Excelben látni szeretnénk. Ám ha a szövegfájl nincs jól strukturálva, csak időigényes manuális munkával tudjuk az Excel táblánkat a kívánt formára hozni – itt jön be a makró a képbe, amivel ezt a manuális munkát néhány tizedmásodperces (nagyméretű állományok esetén néhány másodperces) gépi futásidőre cserélhetjük.

Lássunk egy példát egy Excel szempontból nem ideálisan strukturált szöveges állományra:

example txt export file

Ügyviteli szoftverek export állományaként találkozhatunk hasonlóval. A példa kedvéért legyen ez egy .txt kiterjesztésű fájl, amiben a mezők tabbal vannak elválasztva. Láthatjuk, hogy egy-egy rendelés adatai több és változó számú sort foglalnak el. A rekord első sorában található egy rendelésszám, egy fizetési mód, egy rendelési időpont, a második sorában a vezetéknév, keresztnév, email cím, telefonszám és a város neve, ezután jön tetszőleges számú sorban a tételek felsorolása: darabszám, egységár és cikkszám, majd a rekordot egy összegző sor zárja a megrendelésszámmal és a fizetendő összeggel.

Ha ezt a fájlt egyszerűen beimportáljuk az Excelbe, akkor – nem meglepő módon – ezt kapjuk:

txt file imported into Excel

Ez a későbbi feldolgozás szempontjából – például szűrések, pivot táblák, stb. – nem a legideálisabb. Inkább valami ilyesmire lenne szükségünk:

properly formated table

A továbbiakban két módszert fogok bemutatni a fenti rendezett tábla előállítására: elsőként megnézzük, hogy az Excel beépített szövegimportálója hogyan vezérelhető, illetve hogyan lehet utána a mezőket rendezni; másodikként pedig megnézünk egy alternatív – nagy állományoknál sokkal gyorsabban működő – megoldást.

Az Excel beépített megoldása: Text to Columns

Az Excel saját megoldását alkalmazhatjuk már a táblánkban lévő, szöveget tartalmazó cellák újratördelésére, illetve szöveges fájl Excelben történő megnyitására. Az elsőt a Range objektumon alkalmazott TextToColumns metódussal tudjuk elvégezni, a másodikat pedig a Workbooks gyűjteményen alkalmazott OpenText metódussal. A paraméterezés mindkét esetben ugyanaz – ahogyan menüből manuálisan indítva mindkét módszerrel ugyanahhoz a párbeszédablakhoz jutunk. Példánkban a Workbooks.OpenText metódussal fogjuk a szövegfájlunkat megnyitni.

Ismét kezdjük az elmélettel, és lássuk a legfontosabb paramétereket:

  • Filename – kötelező paraméter, a megnyitandó szövegfájl nevét és elérési útvonalát kell itt megadni.
  • DataType – ezzel a paraméterrel meghatározhatjuk, hogy valamilyen karakter választja el a cellákat (xlDelimited) vagy fix karakterszám szélességű oszlopaink vannak (xlFixedWidth)
  • Tab / Semicolon / Comma / Space / Other – amennyiben a DataType-nál xlDelimited-et adtunk meg, ezekkel a paraméterekkel definiálhatjuk, hogy mi(k) legyen(ek) az elválasztó karakter(ek): tab, pontosvessző, vessző, szóköz, vagy egyéb karakter; bármelyik paramétert állíthatjuk True vagy False-ra. Az Other paraméter kiválasztása esetén az OtherChar paraméterben adhatjuk meg, hogy mi legyen az a bizonyos karakter.
  • FieldInfo – ennek a paraméternek az értelmezése attól függ, hogy mit adtunk meg a DataType paraméternél. Mindkét esetben kételemű tömbökből álló tömböt kell itt megadni (bonyolultan hangzik elsőre…).
    • FixedWidth esetén a kételemű tömb első eleme az oszlop kezdő karakterpozíciója (nullától indítva a számozást), a második eleme pedig az oszlop adattípusa (1: általános, 2: szöveges, vagy 3-10: valamilyen dátum). Például egy, a 10. karakternél kezdődő szöveges mezőt így adunk meg: Array(10,2). Az egyes oszlopokat szintén egy tömb formájában kell megadni, ezért beszélünk tömbökből álló tömbről. Például egy három oszlopos táblát így kell definiálni:
      Array(Array(0,2),Array(9,2),Array(20,2)).
    • Delimited esetén a kételemű tömb első eleme az oszlop sorszáma, a második eleme itt is az oszlop adattípusa. Amelyik oszlopot nem definiáljuk, azt az Excel általános adattípusként fogja értelmezni. Például, ha 5 oszlopból az első és harmadik oszlopot szövegként szeretnénk értelmeztetni, a többit pedig általános típusúként, azt így adhatjuk meg:
      Array(Array(1,2),Array(3,2)), de akár ki is írhatjuk:
      Array(Array(1,2),Array(2,1), Array(3,2),Array(4,1),Array(5,1)).
  • DecimalSeparator – ezzel megadhatjuk, hogy egy számként értelmezendő mezőnél mi a tizedes elválasztó karakter.
  • ThousandsSeparator –  ezzel megadhatjuk, hogy egy számként értelmezendő mezőnél mi az ezres elválasztó karakter.

Térjünk vissza a konkrét példánkra, és nézzük meg, hogy a fentiek hogy is mutatnak a gyakorlatban. Először is deklaráljuk a globális változókat, majd a korábbi bejegyzésben megismert módszerrel kérjük be a megnyitandó fájlt:

Option Explicit
Dim cancel     As Boolean
Dim TxtFajlNev As String

Sub Fajl_Betoltes()
    TxtFajlNev = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If TxtFajlNev = "False" Then
        cancel = True
        Exit Sub
    End If
End Sub

A fájl elérési útvonalát az előző eljárásban eltároltuk (TxtFajlNev), nyissuk meg a fent ismertetett metódussal. A szövegfájlunkban a mezők tabbal vannak elválasztva, és 6 szöveges oszlopot szeretnénk kapni a művelet eredményeképp:

Sub Text_To_Columns()
    Workbooks.OpenText _
        Filename:=TxtFajlNev, _
        DataType:=xlDelimited, _
        Tab:=True, _
        Semicolon:=False, _
        Comma:=False, _
        Space:=False, _
        Other:=False, _
        FieldInfo:= _
            Array(Array(1, 2), Array(2, 2), Array(3, 2), _
            Array(4, 2), Array(5, 2), Array(6, 2))
End Sub

A fenti eljárás eredményeképp megnyílt egy új munkafüzet, amiben még mindig strukturálatlanul szerepelnek az adatok, pont úgy, mint a bejegyzés elején látható képernyőmentésen. Azért, hogy az adatok a kívánt struktúrában, és abban a munkafüzetben jelenjenek meg, amiből a makrókat futtatjuk, egy kis adatrendező eljárásra lesz szükségünk.

Ebben egymásba ágyazott ciklusokkal végigmegyünk az egyes megrendeléseken, illetve a megrendelések egyes tételein, és az adatokat – már a kívánt struktúrában – az Excel táblánk megfelelő cellájába másoljuk. Az algoritmushoz felhasználjuk, hogy:

  • az új megrendelések az A oszlopban kezdődnek, míg a megrendeléshez tartozó adatok és tételek a B oszlopban,
  • a megrendelésszámok közötti sorokban az A oszlopban egy szóköz szerepel a Text To Columns tördelés eredményeképp (és nem üres cella),
  • az új megrendeléssor előtti sor mindig egy összegző sor, amire a strukturált táblában nincs szükségünk.

Első lépésként állítsunk össze egy fejlécet (feltételezve, hogy a táblánk még nem tartalmazza azt). Erre számtalan megoldás lehetséges, a példánkban erre egy gyűjteményt fogunk használni:

Sub FejlecKeszites()
 
'********** Deklarációk ***************
Dim FejlecAs Collection
Dim i As Integer
'**************************************
 
'   Fejléc elemeinek betöltése gyűjteménybe
    Set Fejlec = New Collection
    With Fejlec
        .Add "Megrendelésszám"
        .Add "Fizetési mód"
        .Add "Megrendelés időpontja"
        .Add "Vezetéknév"
        .Add "Keresztnév"
        .Add "Email"
        .Add "Telefonszám"
        .Add "Város"
        .Add "Darabszám"
        .Add "Egységár"
        .Add "Cikkszám"
    End With

'   Fejléc kiírása és formázása
    ThisWorkbook.Sheets(1).Activate
    For i = 1 To Fejlec.Count
        With Cells(1, i)
            .Value = Fejlec(i)
            With .Font
                .Bold = True
                .ColorIndex = 2
            End With
           With .Interior
               .ColorIndex = 11
               .Pattern = xlSolid
           End With
        End With
    Next i
 
End Sub

Ezután jöhet maga a rendező eljárás:

Sub Rendezes()
 
'********** Deklarációk ***************
Dim Megrendelesszam       As String
Dim Fizetesi_mod          As String
Dim Megrendeles_idopontja As String
Dim Vezeteknev            As String
Dim Keresztnev            As String
Dim Email                 As String
Dim Telefonszam           As String
Dim Varos                 As String
Dim Darabszam             As Integer
Dim Egysegar              As Single
Dim Cikkszam              As String
Dim MegrendelesSor        As Long
Dim TetelSor              As Long
Dim TablaSor              As Long
'**************************************
MegrendelesSor = 1
TablaSor = 2

   'Megrendelések ciklusa
    Do
        
        Workbooks(Workbooks.Count).Activate

       'Megrendelés adatainak elmentése változókba
        Megrendelesszam = Cells(MegrendelesSor, 1)
        Fizetesi_mod = Cells(MegrendelesSor, 2)
        Megrendeles_idopontja = Cells(MegrendelesSor, 3)
        Vezeteknev = Cells(MegrendelesSor + 1, 2)
        Keresztnev = Cells(MegrendelesSor + 1, 3)
        Email = Cells(MegrendelesSor + 1, 4)
        Telefonszam = Cells(MegrendelesSor + 1, 5)
        Varos = Cells(MegrendelesSor + 1, 6)
        TetelSor = MegrendelesSor + 2

           'Megrendelés tételek ciklusa
            Do

                Darabszam = Cells(TetelSor, 2)
                Egysegar = Cells(TetelSor, 3)
                Cikkszam = Cells(TetelSor, 4)

               'rekord kiírása excelbe + formázás
                ThisWorkbook.Sheets(1).Activate
                With Cells(TablaSor, 1)
                    .NumberFormat = "@"
                    .Value = Megrendelesszam
                End With
                With Cells(TablaSor, 2)
                    .NumberFormat = "@"
                    .Value = Fizetesi_mod
                End With
                With Cells(TablaSor, 3)
                    .NumberFormat = "yyyy.mm.dd hh:mm:ss"
                    .Value = Megrendeles_idopontja
                End With
                With Cells(TablaSor, 4)
                    .NumberFormat = "@"
                    .Value = Vezeteknev
                End With
                With Cells(TablaSor, 5)
                    .NumberFormat = "@"
                    .Value = Keresztnev
                End With
                With Cells(TablaSor, 6)
                    .NumberFormat = "@"
                    .Value = Email
                End With
                With Cells(TablaSor, 7)
                   .NumberFormat = "@"
                   .Value = Telefonszam
                End With
                With Cells(TablaSor, 8)
                   .NumberFormat = "@"
                   .Value = Varos
                End With
                With Cells(TablaSor, 9)
                   .NumberFormat = "#,##0"
                   .Value = Darabszam
                End With
                With Cells(TablaSor, 10)
                   .NumberFormat = "#,##0"
                   .Value = Egysegar
                End With
                With Cells(TablaSor, 11)
                   .NumberFormat = "@"
                   .Value = Cikkszam
                End With

               'számlálók léptetése
                TetelSor = TetelSor + 1
                TablaSor = TablaSor + 1

               'ellenőrizzük, hogy a tábla végére értünk-e
                Workbooks(Workbooks.Count).Activate
                If TetelSor = Cells(1, 1).CurrentRegion.Rows.Count Then Exit Do

            Loop While Cells(TetelSor + 1, 1) = " "

            'számláló léptetése
            MegrendelesSor = TetelSor + 1

    Loop While MegrendelesSor <= Cells(1, 1).CurrentRegion.Rows.Count
 
End Sub

Már csak egy rövid vezérlő eljárás hiányzik, ami a fenti eljárásokat összefogja, valamint bezárja a nyers adatokat tartalmazó munkafüzetet, mivel arra már nincs szükségünk:

Sub Vezerles()

Application.ScreenUpdating = False

    FejlecKeszites
    Fajl_Betoltes
    Text_To_Columns

        If cancel = True Then Exit Sub

    Rendezes

   'Temp fájl bezárása
    Workbooks(Workbooks.Count).Close

   'oszlopok szélességének beállítása
    ThisWorkbook.Sheets(1).Activate
    Range("A:K").EntireColumn.AutoFit
    Range("A1").Select

Application.ScreenUpdating = True

End Sub

A szövegfájl közvetlen elérése és tömbök használata

Az alternatív megoldásunkban nem Excelbe importáljuk a szövegfájlt és nem munkafüzetek között ugrálva végezzük a rendezést, hanem a szövegfájlt közvetlenül egy tömb változóba olvassuk be, a rendezést is a tömbben végezzük el, és csak a végeredményt írjuk ki Excelbe. Ezzel a megoldással nagyméretű adatállományok esetében jelentősen felgyorsíthatjuk a műveletet az előző megoldáshoz képest.

A szövegfájlból való közvetlen adatkinyerésre az Open utasítást használjuk, méghozzá Input módban. Ez esetben az utasítás így néz ki: Open [fájl neve] For Input As #[fájl száma]. (A szövegfájl megnyitása ilyenkor csak memóriában történik meg, ténylegesen nem jelenik meg.) A fájl megnyitása után egy ciklussal végigmegyünk a szövegfájl sorain, a  Split függvénnyel mezőkre daraboljuk, majd elmentjük egy tömbbe.

Option Explicit
Option Base 1
Dim cancel     As Boolean
Dim TxtFajlNev As String
Dim TxtArr     As Variant
Dim TxtArrSor  As Long
Dim TxtArrOszl As Long
 
Sub Txt_Tombbe()
 
'********** Deklarációk ***************
Dim fNum      As Integer
Dim TxtSor    As String
Dim tmpArr    As Variant
Dim Mezo      As Variant
'**************************************
 
TxtArrSor = 0
fNum = FreeFile
 
    ReDim TxtArr(Txt_MaxSor(TxtFajlNev), 6) 

    Open TxtFajlNev For Input As #fNum

    Do While Not EOF(fNum)

        TxtArrSor = TxtArrSor + 1
        Line Input #fNum, TxtSor
        tmpArr = Split(TxtSor, vbTab)

        TxtArrOszl = 1
        For Each Mezo In tmpArr
            TxtArr(TxtArrSor, TxtArrOszl) = Mezo
            TxtArrOszl = TxtArrOszl + 1
        Next Mezo

    Loop
 
    Close #fNum
 
End Sub

Kiegészítések:

Az Open utasítás használatakor az eljáráson belül a megnyitott fájlra a számával hivatkozunk. Most nincs jelentősége hogy konkrétan mi az a szám, ezért a fNum = FreeFile utasítással az fNum változóhoz hozzárendeljük a következő szabad fájlszámot.

A fájl elérési útvonalát az előző megoldással megegyező módon kérjük be a felhasználótól.

Tulajdonképpen két tömböt használunk: az egyiket (tmpArr) átmeneti jelleggel, csak 1-1 sor eltárolására, majd azt mindig átmásoljuk a másik tömb (TxtArr) megfelelő sorába. A példánkban a teljes táblát tartalmazó tömb dimenzióit  előre definiáljuk: azt tudjuk hogy mindig 6 oszlopos; azt hogy hány soros, pedig egy külön függvénnyel (Txt_MaxSor) állapítjuk meg (lásd később).

A Do… Loop ciklusunkban az EOF (mint End Of File) függvénnyel utasítjuk az eljárást, hogy a fájl végéig minden egyes soron menjen végig és végezze el a cikluson belül írt műveleteket.

A Line Input utasítás a paraméterként megadott fájl (fNum) aktuális sorát a paraméterként megadott String típusú változóba (TxtSor) menti.

A Split függvénnyel az adott sort mezőkre daraboljuk: a függvény paraméterként itt is megadható, hogy a tabot vegye elválasztóként (vbTab).

A következő For… Next ciklussal az átmeneti tömbből átmásoljuk a mezőket a teljes táblát tartalmazó tömbbe.

Végül a Close utasítással bezárjuk a paraméterként megadott szövegfájlt.

 

Egy kis kitérő : Szövegfájl sorainak megszámlálása

Korábban említésre került, hogy a tömb méretének meghatározásához egy külön függvénnyel számoljuk meg, hogy hány soros a szövegfájlunk. Sajnos szövegfájl esetében nem működnek az Excelben használatos tulajdonságok és metódusok, mint a Row és a Count, ezért egy kis trükkhöz kell folyamodnunk. Kézenfekvő megoldás lenne, hogy a fenti eljárásban használt Do While Not EOF… Loop ciklust használjuk fel arra, hogy egyenként megszámoljuk a fájl sorait – ez azonban hosszú fájlok esetében lassú lehet. Ehelyett a szövegben található sortöréseket számoljuk meg. Ehhez bináris módban nyitjuk meg a szövegfájlt olvasásra (Open [fájl neve] For Binary Access Read As #[fájl száma]), majd megszámoljuk a sortörést reprezentáló “Lf” (Line Feed) karaktereket. A függvény elsőre bonyolultnak tűnik, de kitűnően teszi a dolgát: egy több százezer soros fájl sorait is pillanatok alatt képes megszámolni. További magyarázatok nélkül álljon itt a függvény:

Function Txt_MaxSor(FajlNev As String) As Long
 
'********** Deklarációk ***************
Const BufferMeret As Long = 100000
Dim LfAnsi As String
Dim fNum As Integer
Dim FileMeretByte As Long
Dim MaradekByte As Long
Dim Buffer() As Byte
Dim strBuffer As String
Dim BufferPozicio As Long
'**************************************

LfAnsi = StrConv(vbLf, vbFromUnicode)
fNum = FreeFile

    Open FajlNev For Binary Access Read As fNum

    FileMeretByte = LOF(fNum)
    ReDim Buffer(BufferMeret - 1)
    MaradekByte = FileMeretByte

    Do Until MaradekByte = 0
        If BufferPozicio = 0 Then
            If MaradekByte < BufferMeret Then ReDim Buffer(MaradekByte)
            Get #fNum, , Buffer
            strBuffer = Buffer
            MaradekByte = MaradekByte - LenB(strBuffer)
            BufferPozicio = 1
        End If
        Do Until BufferPozicio = 0
            BufferPozicio = InStrB(BufferPozicio, strBuffer, LfAnsi)
            If BufferPozicio > 0 Then
                Txt_MaxSor = Txt_MaxSor + 1
                BufferPozicio = BufferPozicio + 1
            End If
        Loop
    Loop
 
    Close #fNum
 
End Function

A fenti eljárások eredményeképp a szövegfájlunk mezői egy tömbben vannak – egyelőre még nem a kívánt struktúrában. A rendezést az első megoldásban ismertetett módon tudjuk most is megejteni, annyi különbséggel, hogy nem egy munkalap celláit címezzük meg, hanem egy tömb elemeit.

Sub Rendezes()
 
'********** Deklarációk ***************
Dim Megrendelesszam       As String
Dim Fizetesi_mod          As String
Dim Megrendeles_idopontja As String
Dim Vezeteknev            As String
Dim Keresztnev            As String
Dim Email                 As String
Dim Telefonszam           As String
Dim Varos                 As String
Dim Darabszam             As Integer
Dim Egysegar              As Single
Dim Cikkszam              As String
Dim MegrendelesSor        As Long
Dim TetelSor              As Long
Dim TablaSor              As Long
'**************************************
 
MegrendelesSor = 1
TablaSor = 2

    Do

       'Megrendelés adatainak elmentése változókba
        Megrendelesszam = TxtArr(MegrendelesSor, 1)
        Fizetesi_mod = TxtArr(MegrendelesSor, 2)
        Megrendeles_idopontja = TxtArr(MegrendelesSor, 3)
        Vezeteknev = TxtArr(MegrendelesSor + 1, 2)
        Keresztnev = TxtArr(MegrendelesSor + 1, 3)
        Email = TxtArr(MegrendelesSor + 1, 4)
        Telefonszam = TxtArr(MegrendelesSor + 1, 5)
        Varos = TxtArr(MegrendelesSor + 1, 6)

        TetelSor = MegrendelesSor + 2

        Do

            Darabszam = TxtArr(TetelSor, 2)
            Egysegar = TxtArr(TetelSor, 3)
            Cikkszam = TxtArr(TetelSor, 4)

           'rekord kiírása excelbe + formázás
            With Cells(TablaSor, 1)
                .NumberFormat = "@"
                .Value = Megrendelesszam
            End With
            With Cells(TablaSor, 2)
                .NumberFormat = "@"
                .Value = Fizetesi_mod
            End With
            With Cells(TablaSor, 3)
                .NumberFormat = "yyyy.mm.dd hh:mm:ss"
                .Value = Megrendeles_idopontja
            End With
            With Cells(TablaSor, 4)
                .NumberFormat = "@"
                .Value = Vezeteknev
            End With
            With Cells(TablaSor, 5)
                .NumberFormat = "@"
                .Value = Keresztnev
            End With
            With Cells(TablaSor, 6)
                .NumberFormat = "@"
                .Value = Email
            End With
            With Cells(TablaSor, 7)
                .NumberFormat = "@"
                .Value = Telefonszam
            End With
            With Cells(TablaSor, 8)
                .NumberFormat = "@"
                .Value = Varos
            End With
            With Cells(TablaSor, 9)
                .NumberFormat = "#,##0"
                .Value = Darabszam
            End With
            With Cells(TablaSor, 10)
                .NumberFormat = "#,##0"
                .Value = Egysegar
            End With
            With Cells(TablaSor, 11)
                .NumberFormat = "@"
                .Value = Cikkszam
            End With

           'számlálók léptetése
            TetelSor = TetelSor + 1
            TablaSor = TablaSor + 1

           'Ellenőrizzük, hogy a tábla végére értünk-e
            If TetelSor = UBound(TxtArr) Then Exit Do

        Loop While TxtArr(TetelSor + 1, 1) = " "

       'számláló léptetése
        MegrendelesSor = TetelSor + 1

    Loop While MegrendelesSor <= UBound(TxtArr)
 
End Sub

Az itt nem részletezett lépések (fájl elérési útvonalának bekérése, fejléc készítése, vezérlő eljárás) a második megoldás esetében is ugyanúgy történik, mint az elsőben.

Vélemény, hozzászólás?

Az e-mail-címet nem tesszük közzé.