从文本文件中加载VBA中的格式化数据
问题描述:
我正在寻找在VBA中加载格式化数据的最佳方式。我花了相当长的时间试图找到类似C或Fortran的类似函数fscanf
,但没有成功。从文本文件中加载VBA中的格式化数据
基本上我想从一个文本文件中读取数百万个数字,每个数字有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工作表中加载的行数太多。我可以想到一种蛮力的方式,在这种方式中,我看着每一个连续的角色,并确定它是一个空格还是一个数字,但它看起来非常笨拙。
我对如何编写格式化数据的指针也很感兴趣,但是这似乎更简单 - 只是格式化每个字符串并使用&
连接它们。
答
下面的代码片段会从一个文本文件中读取空格分隔的数字:
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
答
你也可以使用正则表达式来替代多个空格一个空格,然后使用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-25 15:03:18
很高兴能有帮助:) – 2009-06-25 15:19:30