RSS

Opsplitning af tekstfiler til mindre filer med Excel VBA

På denne side viser jeg, hvordan man med VBA kan opdele en tekstfil i mindre filer med et brugerdefineret antal (maksimum) linjer eller rækker.

Makroen indeholder eksempler på, hvordan man indlæser et brugervalgt filnavn, hvordan filens tekst kan indlæses i et array med 1 linje pr. række med VBA-funktionen "Split()," hvordan man kan skrive indholdet af et array til en tekststreng med linjeskift samt skrive filen til disken.

Du kan markere koden med musen, kopiere den med CTRL+c og sætte den ind i et VBA-modul med CTRL+v. Bruger du en lille skærm, kan nogle af kodelinjerne være ombrudte, men linjeskiftene er OK, når du indsætter koden i et VBA-modul.

Det kom sig egentlig af, at jeg ville analysere logfiler for min hjemmeside med Excel. Disse logfiler kan være endog meget store, og da jeg bruger Excel 2003, hvor der "kun" er plads til 65.536 rækker, så jeg mig om efter en løsning, som kunne opdele logfilerne i spiselige portioner.

Jeg fandt flere forslag på nettet, men jeg kunne ikke få dem til at fungere. Måske var jeg ikke grundig nok, måske for utålmodig, men det gjorde, at jeg i stedet skrev min egen makro.

Det kan sikkert gøres smartere, men det virker for mig og går rimelig hurtigt. De nye filer gemmes i samme katalog som originalfilen og får samme navn + et nummer (navn1.txt, navn2.txt osv.).

Koden kan også bruges på .csv-filer, så skal man blot ændre "txt" til "csv".


Sub SplitTextFile()
'Opsplitter en tekst- eller csv-fil i mindre
'filer med et brugerdefineret antal (max)
'linjer eller rækker. De nye filer får det
'originale filnavn + et nummer (1,2,3 osv.).

Dim sFile As String  'Navnet på den originale fil
Dim sText As String  'Filens tekst
Dim lStep As Long    'Max antal linjer i nye filer
Dim vX, vY           'Variant arrays. vX=input, vY=output
Dim iFile As Integer 'Filnummer fra Windows
Dim lCount As Long   'Tæller
Dim lIncr As Long    'Nummer til filnavn
Dim lMax As Long     'Øvre grænse for loop
Dim lNb As Long      'Tæller
Dim lSoFar As Long   'Hvor langt er vi kommet?

On Error GoTo ErrorHandle

'Lader brugeren vælge en fil
sFile = Application.GetOpenFilename()

'Hvis brugeren ikke valgte en fil
If sFile = "False" Then Exit Sub

'Bed brugeren om max antal linjer i hver ny fil.
'Fx 65536.
lStep = Application.InputBox("Max antal rækker/linjer?", Type:=1)

'Da vores arrays bruger nul i LBound, trækker vi 1 fra.
lStep = lStep - 1

'Indlæs teksten i sText
sText = _
CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile).ReadAll

'Indlæser teksten i arrayet vX, hvor en linefeed karakter
'(ny linje) starter en ny post/række.
'Her bruges linefeed karakteren = Chr(10)
'Virker det ikke, så prøv fx
''vX = Split(sText, vbCrLf)
'som er Carriage return–linefeed kombination.
'Det kunne også være mellemrum, tabulatortegn
'osv., men det er et emne for sig.
vX = Split(sText, vbLf)

'Frigør hukommelse
sText = ""

'Nu startes en løkke, som kører indtil alle
'rækker i arrayet vX er læst og gemt i nye filer.
'Variablen lSoFar holder styr på, hvor langt vi
'er kommet.
Do While lSoFar < UBound(vX)
   'Hvis antal rækker minus lSoFar er
   'større end max antal rækker, dimensioneres
   'arrayet vY til max antal rækker.
   If UBound(vX) - lSoFar >= lStep Then
      ReDim vY(lStep)
      'lMax sættes = sidste rækkenummer, der
      'skal kopieres til vY.
      lMax = lStep + lSoFar
   Else
      'Ellers dimensioneres vY til det antal
      'rækker, der er tilbage.
      ReDim vY(UBound(vX) - lSoFar)
      'Sidste række som skal kopieres er =
      'sidste række i vX.
      lMax = UBound(vX)
   End If
   
   lNb = 0
   'Nu kopieres rækkerne fra vX til vY
   For lCount = lSoFar To lMax
      vY(lNb) = vX(lCount)
      lNb = lNb + 1
   Next
   
   'lSoFar holder styr på, hvor langt
   'vi er kommet i vX.
   lSoFar = lCount
   
   'Får et ledigt filnummer af Windows
   iFile = FreeFile
   
   'Tæller op på det nummer som puttes
   'i enden af det nye filnavn.
   lIncr = lIncr + 1
   
   'Gemmer vY som tekstfil (.txt). Det kunne også være som .csv.
   'Filnavnet er det originale + lIncr
   Open sFile & "-" & lIncr & ".txt" For Output As #iFile
      'Join-kommandoen samler vY's rækker til en tekststreng
      'med linjeskift.
      Print #iFile, Join$(vY, vbCrLf)
   Close #iFile
Loop

Erase vX
Erase vY

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure SplitTextFile"
End Sub

Det var det. Originalfilen er nu delt op i mindre filer med det antal linjer, brugeren definerede. Den sidste fil vil dog næsten altid være mindre end de øvrige.

Relateret