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:
Ü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:
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:
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)).
- 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:
- 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.