1

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

基本上，我想从一个文本文件中读取数百万个放置在许多（100,000 行）行上的数字，每行有 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 工作表中加载的行太多。我可以想到一种蛮力的方式，我查看每个连续的字符并确定它是空格还是数字，但这似乎非常笨拙。

我也对如何编写格式化数据的指针感兴趣，但这似乎更容易——只需格式化每个字符串并使用&.

4

2 回答 2

4

以下代码段将从文本文件中读取以空格分隔的数字：

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
于 2009-06-25T14:03:58.983 回答
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
于 2009-06-25T14:34:05.633 回答