从文本文件中加载VBA中的格式化数据

Question

我正在寻找在VBA中加载格式化数据的最佳方式。我花了相当长的时间试图找到类似C或Fortran的类似函数fscanf，但没有成功。

基本上我想从一个文本文件中读取数百万个数字，每个数字有10个数字（除了最后一行，可能是1-10个数字）。数字之间用空格分开，但事先并不知道每个字段的宽度（并且这个宽度在数据块之间变化）。 例如

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 

以前我用过的Mid功能，但在这种情况下，我不能，因为我不可能提前知道每个字段的宽度做。另外，在Excel工作表中加载的行数太多。我可以想到一种蛮力的方式，在这种方式中，我看着每一个连续的角色，并确定它是一个空格还是一个数字，但它看起来非常笨拙。

我对如何编写格式化数据的指针也很感兴趣，但是这似乎更简单 - 只是格式化每个字符串并使用&连接它们。

Answer 1

下面的代码片段会从一个文本文件中读取空格分隔的数字：

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 

更新：这里是你如何可以一次读取一行，与项目的每行可变数量：

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

你也可以使用正则表达式来替代多个空格一个空格，然后使用Split函数像例子中每一行代码如下所示。

经过65000行处理后，新工作表将被添加到Excel工作簿中，以便源文件可以大于Excel中的最大行数。

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