Laden von formatierten Daten in VBA aus einer Textdatei

Question

Ich bin auf der Suche nach dem besten Weg zum Laden formatierter Daten in VBA. Ich habe ziemlich viel Zeit damit verbracht, das Äquivalent von C-like oder Fortran-artigen fscanf Typ-Funktionen zu finden, aber ohne Erfolg.

Grundsätzlich möchte ich aus einer Textdatei Millionen von Zahlen lesen, die auf vielen (100.000) Zeilen mit jeweils 10 Nummern (außer der letzten Zeile, möglicherweise 1-10 Nummern) platziert sind. Die Zahlen sind durch Leerzeichen getrennt, aber ich weiß nicht im Voraus die Breite jedes Feldes (und diese Breite ändert sich zwischen Datenblöcken). z.B.

397143.1 396743.1 396343.1 395943.1 395543.1 395143.1 394743.1 394343.1 393943.1 393543.1 

    -0.11 -0.10 -0.10 -0.10 -0.10 -0.09 -0.09 -0.09 -0.09 -0.09 

0.171 0.165 0.164 0.162 0.158 0.154 0.151 0.145 0.157 0.209 

Früher habe ich die Mid Funktion aber in diesem Fall verwendet, kann ich nicht, weil ich im Voraus die Breite der einzelnen Felder nicht kennen. Außerdem sind zu viele Zeilen in einem Excel-Arbeitsblatt zu laden. Ich kann mir eine rohe Gewaltmethode vorstellen, bei der ich jeden nachfolgenden Charakter betrachte und feststelle, ob es ein Raum oder eine Zahl ist, aber er scheint furchtbar ungeschickt zu sein.

Ich bin auch interessiert an Zeigern zum Schreiben von formatierten Daten, aber das scheint einfacher - formatieren Sie einfach jede Zeichenfolge und verketten Sie sie mit &.

Answer 1

Das folgende Snippet Leerzeichen getrennte Zahlen aus einer Textdatei lesen:

Dim someNumber As Double 

Open "YourDataFile.txt" For Input As #1 

Do While Not (EOF(1)) 
    Input #1, someNumber 
    `// do something with someNumber here...` 
Loop 

Close #1 

Update: Hier ist, wie Sie eine Zeile zu einem Zeitpunkt, mit einer variablen Anzahl von Elementen in jeder Zeile lesen konnten :

Dim someNumber As Double 
Dim startPosition As Long 
Dim endPosition As Long 
Dim temp As String 

Open "YourDataFile" For Input As #1 

Do While Not (EOF(1)) 
    startPosition = Seek(1) '// capture the current file position' 
    Line Input #1, temp  '// read an entire line' 
    endPosition = Seek(1) '// determine the end-of-line file position' 
    Seek 1, startPosition '// jump back to the beginning of the line' 

    '// read numbers from the file until the end of the current line' 
    Do While Not (EOF(1)) And (Seek(1) < endPosition) 
     Input #1, someNumber 
     '// do something with someNumber here...' 
    Loop 

Loop 

Close #1 

Answer 2

Sie auch reguläre Ausdrücke zu ersetzen mehrere Leerzeichen zu einem Raum und verwenden Sie die Split-Funktion für jede Zeile wie die Beispiel-Code zeigt unten verwenden könnte.

Nachdem 65000 Zeilen verarbeitet wurden, wird der Excel-Arbeitsmappe ein neues Blatt hinzugefügt, sodass die Quelldatei größer als die maximale Anzahl der Zeilen in Excel sein kann.

Dim rx As RegExp 

Sub Start() 

    Dim fso As FileSystemObject 
    Dim stream As TextStream 
    Dim originalLine As String 
    Dim formattedLine As String 
    Dim rowNr As Long 
    Dim sht As Worksheet 
    Dim shtCount As Long 

    Const maxRows As Long = 65000 

    Set fso = New FileSystemObject 
    Set stream = fso.OpenTextFile("c:\data.txt", ForReading) 

    rowNr = 1 
    shtCount = 1 

    Set sht = Worksheets.Add 
    sht.Name = shtCount 

    Do While Not stream.AtEndOfStream 
     originalLine = stream.ReadLine 
     formattedLine = ReformatLine(originalLine) 
     If formattedLine <> "" Then 
      WriteValues formattedLine, rowNr, sht 
      rowNr = rowNr + 1 
      If rowNr > maxRows Then 
       rowNr = 1 
       shtCount = shtCount + 1 
       Set sht = Worksheets.Add 
       sht.Name = shtCount 
      End If 
     End If 
    Loop 

End Sub 


Function ReformatLine(line As String) As String 

    Set rx = New RegExp 

    With rx 
     .MultiLine = False 
     .Global = True 
     .IgnoreCase = True 
     .Pattern = "[\s]+" 
     ReformatLine = .Replace(line, " ") 
    End With 

End Function 


Function WriteValues(formattedLine As String, rowNr As Long, sht As Worksheet) 

    Dim colNr As Long 
    colNr = 1 

    stringArray = Split(formattedLine, " ") 
    For Each stringItem In stringArray 
     sht.Cells(rowNr, colNr) = stringItem 
     colNr = colNr + 1 
    Next 

End Function