Herbers Excel-Forum - das Archiv

Einlesen von großen Textdateien per VBA

Bild

Betrifft: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 04.01.2007 22:56:56
Hallo,
per VBA lasse ich eine Textdatei in Excel importieren:
ChDir Laufwerk
Workbooks.OpenText Filename:= _
WoNat1 _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth,FieldInfo:= _
Array(Array(0, 1), Array(12, 1), Array(20, 1), Array(23, 1), _
Array(29,1), Array(36, 1), Array(43, 1), _
Array(50, 1), Array(57, 1), Array(64, 1), Array(71, 1), Array(78, _
1), Array(85, 1), Array( _
92, 1), Array(99, 1), Array(106, 1), Array(113, 1), Array(120, 1), _
Array(127, 1), Array(133, 1)), TrailingMinusNumbers:=True
Soweit funktioniert das alles. Das Problem habe ich nur dann, wenn die Datei zu groß ist und mir die 65536 Zeilen nicht ausreichen.
Gibt es eine Möglichkeit, dass, wenn die 65536 Zeilen überschritten werden, die weiteren Daten in die nächsten Tabellen eingelesen werden ??
Ist kompliziert, hoffe aber, dass mir jemand helfen kann.
Vielen Dank
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ramses
Geschrieben am: 04.01.2007 23:00:59
Hallo
schau mal ob dir das was hilft
http://www.office.gmxhome.de/_excel_vba_externe_daten.htm
Gruss Rainer
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 04.01.2007 23:27:35
Hi Rainer,
danke für Deine Antwort. Den Link hatte ich auch schon im Internet gefunden. Allerdings konnte ich damit nicht sehr viel anfangen, da meine VBA-Kenntnisse auch nicht so toll sind. Ich dachte, dass es evtl. einen einfacheren Code gibt, den ich bei meinem ergänzen kann. Vielleicht gibts ja noch andere Alternativen ??
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ramses

Geschrieben am: 04.01.2007 23:31:57
Hallo
dann probier mal das
Sub Read_Big_File()
    'Liest csv und txt Datein mit mehr als 65536 Datensätzen ein
    'und erstellt automatisch eine neu Arbeitsmappe und Worksheets
    'Der eingelesene Text wird in Spalte 1 geschrieben
    '------------------------------
    'Hilfsvariable für Anzahl Datensätze
    Dim Text1 As String
    'Variablen für den Array nötig
    Dim txtLines As Long, i As Long, n As Long
    'Neue Mappe und Variables Tabellenblatt deklarieren
    Dim tWkb As Workbook, tWks As String
    'Für Office97 muss das Array TextArr als String definiert werden
    'Entdeckt duch Gerd Z aus dem Herber Forum
    Dim TextArr As Variant
    Dim ReadFile As String
    Dim OldStatusbar
    'Dialog öffnen auf Basis von *.dat Files
    ReadFile = Application.GetOpenFilename("CSV Files (*.csv;*.txt),")
    'Schliessen einer geöffneten Datei
    Close #1
    '1. Öffnen der Datei
    'Den Namen und Pfad bitte anpassen
    Open ReadFile For Input As #1
    'Die anzahl ist nötig um die Grösse des Arrays zu deklarieren
    'Zähler auf 0 setzen
    txtLines = 0
    Do While Not EOF(1) ' Schleife bis Dateiende.
        Input #1, Text1 ' Hilfsvariable zum einlesen verwenden
        'Zähler hochzählen
        txtLines = txtLines + 1
    Loop
    'Schliessen der Datei weil Dateiende erreicht wurde
    Close #1
    'Erneutes Öffnen um zum Dateianfang zu kommen
    Open ReadFile For Input As #1 ' Datei zum Einlesen öffnen.
    'Array neu auf die Anzahl der Linien initialisieren
    ReDim TextArr(txtLines)
    'Einlesen der Dateien in das Array
    For i = 1 To txtLines
        Input #1, TextArr(i)
    Next i
    Close #1
    'Arbeitsmappe erstellen und zuweisen
    Workbooks.Add
    Set tWkb = ActiveWorkbook
    'Alles löschen bis auf eine Tabelle
    '>> Kosmetik :-)
    For i = 2 To Worksheets.count
        Application.DisplayAlerts = False
        Worksheets(i).Delete
        Application.DisplayAlerts = True
    Next
    OldStatusbar = Application.DisplayStatusBar
    'Namen vergeben
    Worksheets(1).name = "Data1"
    tWks = tWkb.Worksheets(1).name
    'Daten in aktuelles Sheet schreiben
    n = 1
    For i = 1 To txtLines
        Application.StatusBar = "Datensatz " & i & " von " & txtLines & " wird eingelesen"
        'Neue Tabelle anlegen wenn Zelle 65536 erreicht wurde
        If i Mod 65536 = 0 Then
            Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, Semicolon:=True, FieldInfo:=Array(1, 1)
            tWkb.Worksheets.Add after:=ActiveSheet
            ActiveSheet.name = "Data" & i
            tWks = ActiveSheet.name
            n = 1
        End If
        tWkb.Worksheets(tWks).Cells(n, 1) = TextArr(i)
        n = n + 1
    Next i
    MsgBox ReadFile & " mit " & txtLines & " Datensätzen vollständig eingelesen"
    Application.DisplayStatusBar = OldStatusbar
End Sub

Aber viel einfacher geht es nicht mehr :-)
Gruss Rainer
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo
Geschrieben am: 04.01.2007 23:41:41
Hi Ramses,
das klappt schon sehr gut. Muss jetzt nur mal versuchen, einiges zu verändern.
Vielen vielen Dank erst einmal für Deine Hilfe. Mal sehen, ob ich das alleine schaffen werde. :-)
Schöne Grüße
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 04.01.2007 23:58:39
Hallo Ramses,
das einzige Problem ist, dass die Textdatei nur in die erste Spalte im Excel übernommen wird. Bei meinem Code:
ChDir Laufwerk
Workbooks.OpenText Filename:= _
WoNat1 _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth,FieldInfo:= _
Array(Array(0, 1), Array(12, 1), Array(20, 1), Array(23, 1), _
Array(29,1), Array(36, 1), Array(43, 1), _
Array(50, 1), Array(57, 1), Array(64, 1), Array(71, 1), Array(78, _
1), Array(85, 1), Array( _
92, 1), Array(99, 1), Array(106, 1), Array(113, 1), Array(120, 1), _
Array(127, 1), Array(133, 1)), TrailingMinusNumbers:=True
wir die Textdatei geöffnet und in die einzelnen Spalten übernommen. Wie siehts aus, kann man diesen Code in den anderen einsetzen ?? Das wäre dann die Lösung !
Dank für Deine Hilfe
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ramses
Geschrieben am: 05.01.2007 00:15:14
Hallo
Wieso sollte ich den Code einbauen ? Das ist nicht nötig.
Was wird in der Textdatei als Trennzeichen verwendet ?
Gruss Rainer
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 05.01.2007 00:28:19
Hi Ramses,
ich habe ein Beispiel-Textdatei beigefügt. So sieht die gesamte Textdatei aus. Das Problem ist jetzt, dass beim Einlesen mit dem Code, die Zahlen untereinander stehen. Dabei sollte die Tabellenform aus der Textdatei übernommen werden.
https://www.herber.de/bbs/user/39393.txt
Gruss
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ramses

Geschrieben am: 05.01.2007 00:44:23
Hallo
Sorry, aber das ist so nicht möglich wenn es mehr als 65366 Datensätze sind.
Das einzige was mir hierzu einfällt ist, die Textdatei vorher in zu importierende TXT-Files zu zerlegen, die nur jeweils 65536 zeilen haben.
Dann könnte man das mit deinem Code machen.
Aber so ist das leider nicht möglich, wenn die Tabellenstruktur der Textdatei erhalten bleiben soll.
Aber dazu ist es jetzt zu spät, bzw. zu früh.
Mal sehen, vielleicht komme ich heute im Laufe des Tages dazu.
Gruss Rainer
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo
Geschrieben am: 05.01.2007 00:49:16
Hi Rainer,
danke für Deine Hilfe. Wenn es nicht geht, dann geht es eben nicht. Wäre schön, wenn Dir noch etwas einfallen könnte. Wünsche erst einmal eine gute Nacht !
Danke
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ramses

Geschrieben am: 05.01.2007 01:40:01
Hallo
Hat mir nun doch keine Ruhe gelassen :-)
Der folgende Code ist etwas anders aufgebaut und funktioniert mal bis zu ca. 130'000 Datensätzen.
Aufgrund deiner Beispieldatei wurde die Feldstruktur ermittelt.
Der Import bei mir funkiontiert wie ein normales öffnen der Textdatei.

Sub Read_Big_File_Hold_Structure()
    '(C) Ramses
    Dim myFSO As Object, myFile As Variant, myTxtStream As Variant, myText As Variant
    Dim i As Long, tarRow As Long, impSheetNr As Integer
    Dim tarWks As Worksheet
    Dim arrFieldStructure(), minFieldLen As Integer
    Dim tmpString As String, partLen As Integer
    'Dialog öffnen auf Basis von *.txt Files
    myFile = Application.GetOpenFilename("TXT Files (*.txt),")
    If myFile = "" Or myFile = False Then Exit Sub
    'Feldstruktur definieren
    arrFieldStructure = Array(16, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8)
    impSheetNr = 1
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    'Hier bitte den Dateinamen anpassen :
    Set myFile = myFSO.GetFile(myFile)
    Set myTxtStream = myFile.OpenAsTextStream(1)
    'Datei bis zum Ende Einlesen
    tarRow = 1
    ActiveSheet.Name = "Import_" & impSheetNr
    Set tarWks = Worksheets(ActiveSheet.Name)
    Do While Not myTxtStream.AtEndOfStream
        If i < 65536 Then
            tmpString = myTxtStream.readline
            tarWks.Cells(tarRow, 1) = Left(tmpString, arrFieldStructure(0))
            partLen = arrFieldStructure(0)
            For i = 1 To UBound(arrFieldStructure)
                tarWks.Cells(tarRow, i + 1) = Mid(tmpString, partLen, arrFieldStructure(i))
                partLen = partLen + arrFieldStructure(i)
            Next i
            If Len(tmpString) > partLen Then
                tarWks.Cells(tarRow, tarWks.Cells(tarRow, 255).End(xlToLeft).Column) = Right(tmpString, Len(tmpString) - partLen)
            End If
            tarRow = tarRow + 1
        Else
            impSheetNr = impSheetNr + 1
            Worksheets.Add after:=Worksheets(ActiveSheet.Index)
            With ActiveSheet
                .Name = "Import_" & impSheetNr
            End With
            Set tarWks = Worksheets(ActiveSheet.Name)
            tarRow = 1
        End If
    Loop
    myTxtStream.Close
End Sub

Gruss Rainer
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 05.01.2007 07:55:32
Hallo Rainer,
guten Morgen ! ! Vielen Dank für Deine Mühe. Das hört sich sehr gut an. Ich werde gleich zur Arbeit fahren und dort weitermachen. Werde auf jeden Fall berichten, ob es geklapt hat. Vielen Dank noch einmal ! !
Gruss
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 05.01.2007 10:08:34
Hallo Rainer,
nochmal vielen Dank für Deine Hilfe. Ich habe das jetzt mal ausprobiert. Das klappt soweit ganz gut, jedoch bekomme ich eine Fehlermeldung, sobald er eine Tabelle vollgeschrieben hat und eigentlich die zweite Tabelle füllen müsste. Folgende Fehlermeldung:
Laufzeitfehler 1004, Anwendungs- oder objektdefinierter Fehler
folgende Zeile wird beim Debuggen angezeigt:
--- tarWks.Cells(tarRow, 1) = Left(tmpString, arrFieldStructure(0)) ---
----------------------------------------------------------------
Weisst Du was das sein kann ?ß
Gruss
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ramses

Geschrieben am: 05.01.2007 10:28:37
Hallo
wenn er den Debugger bringt kannst du dann mal mit dem Mauszeiger über "tarWks", "tarRow" und "tmpString" gehen was er dann in dem QuickInfo Feld anzeigt.
Ausserdem habe ich gesehen, dass ich zu später Stunden die gleiche Variable zwei mal verwende innerhalb der gleichen Schleife
For i = 1 To UBound(arrFieldStructure)
tarWks.Cells(tarRow, i + 1) = Mid(tmpString, partLen, arrFieldStructure(i))
partLen = partLen + arrFieldStructure(i)
Next i
Ändere in dem oberen Code-Segement "i" gegen "n".
Am Anfang des Codes muss diese Variable noch deklariert werden.
gruss Rainer
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 05.01.2007 13:19:36
Hallo Rainer,
die Änderung habe ich vorgenommen. Es funktioniert aber trotzdem so wie vorher auch. Folgende Meldungen, wenn ich mit der Maus auf die Texte gehe:
tarRow=65537
arrFieldStructure(0)=13
tmpString= (hier zeigt er einen langen Text aus der Textdatei)
Hilft Dir das ??
Gruss
Ronaldo
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ramses

Geschrieben am: 05.01.2007 18:09:11
Hallo
musste noch ein klein wenig umschreiben
Option Explicit

Sub Read_Big_File_Hold_Structure()
    '(C) Ramses
    Dim myFSO As Object, myFile As Variant, myTxtStream As Variant, myText As Variant
    Dim i As Long, n As Byte, tarRow As Long, rowCounter As Long, txtLines As Long, impSheetNr As Integer
    Dim tarWks As Worksheet, Text1 As Variant
    Dim arrFieldStructure(), minFieldLen As Integer
    Dim tmpString As String, partLen As Integer
    'Dialog öffnen auf Basis von *.txt Files
    myFile = Application.GetOpenFilename("TXT Files (*.txt),")
    If myFile = "" Or myFile = False Then Exit Sub
    
    'Für Fortschrittsanzeige
    Open myFile For Input As #1
    'Die anzahl ist nötig um die Grösse des Arrays zu deklarieren
    'Zähler auf 0 setzen
    txtLines = 0
    Do While Not EOF(1) ' Schleife bis Dateiende.
        Input #1, Text1 ' Hilfsvariable zum einlesen verwenden
        'Zähler hochzählen
        txtLines = txtLines + 1
    Loop
    'Schliessen der Datei weil Dateiende erreicht wurde
    Close #1
    'Feldstruktur definieren
    arrFieldStructure = Array(16, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8)
    impSheetNr = 1
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    'Hier bitte den Dateinamen anpassen :
    Set myFile = myFSO.GetFile(myFile)
    Set myTxtStream = myFile.OpenAsTextStream(1)
    'Datei bis zum Ende Einlesen
    tarRow = 1
    rowCounter = 1
    ActiveSheet.Name = "Import_" & impSheetNr
    Set tarWks = Worksheets(ActiveSheet.Name)
    Application.ScreenUpdating = False
    Debug.Print "Start: " & Time
    x = Time
    Do While Not myTxtStream.AtEndOfStream
        If tarRow Mod 65536 <> 0 Then
            Application.StatusBar = rowCounter & " von " & txtLines & " verarbeitet"
            tmpString = myTxtStream.readline
            tarWks.Cells(tarRow, 1) = Left(tmpString, arrFieldStructure(0))
            partLen = arrFieldStructure(0)
            For n = 1 To UBound(arrFieldStructure)
                tarWks.Cells(tarRow, n + 1) = Mid(tmpString, partLen, arrFieldStructure(n))
                partLen = partLen + arrFieldStructure(n)
            Next n
            If Len(tmpString) > partLen Then
                tarWks.Cells(tarRow, tarWks.Cells(tarRow, 255).End(xlToLeft).Column) = Right(tmpString, Len(tmpString) - partLen)
            End If
            tarRow = tarRow + 1
            rowCounter = rowCounter + 1
        Else
            impSheetNr = impSheetNr + 1
            Worksheets.Add after:=Worksheets(ActiveSheet.Index)
            With ActiveSheet
                .Name = "Import_" & impSheetNr
            End With
            Set tarWks = Worksheets(ActiveSheet.Name)
            tarRow = 1
            rowCounter = rowCounter + 1
        End If
    Loop
    Application.ScreenUpdating = True
    myTxtStream.Close
    Debug.Print "Ende: " & Time
    Debug.Print "Import Dauer: " & Format(Time - x, "hh:mm:ss")
End Sub

Der Code benötigt bei mir für den Import von 250'000 Datensätzen/Zeilen (Habe den Inhalt deiner Datei einfach kopiert = 17.5 MB) 1 Min 57 Sek. und läuft einwandfrei durch.
Hoffentlich hilfts :-)
Gruss Rainer
Bild

Betrifft: AW: Einlesen von großen Textdateien per VBA
von: Ronaldo

Geschrieben am: 05.01.2007 21:51:37
Hallo Rainer,
es klappt einwandfrei ohne Fehler ! ! ! !
Ich danke Dir vielmals für Deine Mühe ! ! ! Schön, dass es in diesem Forum Leute wie Dich gibt ! :-)
Danke
Ronaldo
 Bild
Excel-Beispiele zum Thema "Einlesen von großen Textdateien per VBA"
Tabellenblattnamen in ein Listenfeld einlesen Gefilterte Daten in eine ListBox einlesen
Einlesen von Zellinhalten in Variablen 1000 Arbeitsblätter aus 1000 Arbeitsmappen einlesen
Tabellenblattnamen in eine ListBox einlesen Text aus UserForm-Textbox in Variable einlesen
Blätter in ComboBox-Feld einlesen und auswählen Dateinamen in Tabelle einlesen
Namen einer Arbeitsmappe einlesen 400 leere Textdateien anlegen