如何通过 VBA 优化从 excel 中的超大文本文件中提取数据的性能
How to optimize the performance of data pulling from a very large text file in excel via VBA
我想获取有关某行中关键单元格值的值的数据。
问题是文件真的很大,我有一个 .txt 文件,大约有 54000 行和 14 列,因此文本文件本身有 20 MB,超过这个我需要得到 D 列的值F 列中的值。
F 列中的值是唯一的。
到目前为止,我已经尝试过直接方法从 .txt 文件中提取数据并将其复制到 sheet,然后 运行 一个循环来获取附加值。
但是即使等待 15 分钟,代码也无法从 .txt 文件中提取数据。
Do While bContinue = True
outRow = 1
sInputFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If sInputFile = "False" Then
bContinue = False
Reset 'close any opened text file
Exit Sub
Else
outCol = outCol + 2
'process text file
fNum = FreeFile
Open sInputFile For Input As #fNum
Do While Not EOF(fNum)
outRow = outRow + 1
Line Input #fNum, sInputRecord
Sheets("Sheet1").Cells(outRow, outCol).Value = sInputRecord
Loop
Close #fNum
End If
Loop
errHandler:
Reset
End Sub
我预计它会花一些时间,但 运行 这段代码会花费很长时间,这会破坏使用宏的目的。
我只是请求是否有人有更好的方法来解决这个问题。
缺少代码的第一部分,但我猜你声明了变量。如果没有,那可能对性能有一点帮助。
您也可以尝试在进程开始时关闭计算,然后在结束时切换回来。
Application.Calculation = xlCalculationManual
'...
Application.Calculation = xlCalculationAutomatic
你说你只需要文本中的第 4 和第 6 列,但你将整行都放在一个单元格中。
如果您真的只想将一行的这两部分放入 sheet,您可能需要这样做:
With Sheets("Sheet1")
Do While Not EOF(fNum)
outRow = outRow + 1
Line Input #fNum, sInputRecord
.Cells(outRow, outCol).Value = Split(sInputRecord,";")(3)
.Cells(outRow, outCol+1).Value = Split(sInputRecord,";")(5)
Loop
End With
将分号更改为分隔符在 txt 文件中的任何字符。
请试试这个并反馈。
Sub TryMe()
Dim cN As ADODB.Connection '* Connection String
Dim RS As ADODB.Recordset '* Record Set
Dim sQuery As String '* Query String
On Error GoTo ADO_ERROR
cN = New ADODB.Connection
cN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\;Extended Properties=""text;HDR=Yes;FMT=Delimited(,)"";Persist Security Info=False"
cN.ConnectionTimeout = cN.Open()
RS = New ADODB.Recordset
sQuery = "Select * From VBA.csv ORDER BY ID"
RS.ActiveConnection = cN
RS.Source = sQueryRS.Open()
If RS.EOF <> True Then
While RS.EOF = False
Open "c:\temp\vba_sorted.csv" For Append As 1
Print #1, RS.Fields(0) & "," & RS.Fields(1); RS.MoveNext()
Close #1
End If
If Not RS Is Nothing Then RS = Nothing
If Not cN Is Nothing Then cN = Nothing
ADO_ERROR:
If Err <> 0 Then
Debug.Assert (Err = 0)
MsgBox (Err.Description)
Resume Next
End If
End Sub
我想获取有关某行中关键单元格值的值的数据。 问题是文件真的很大,我有一个 .txt 文件,大约有 54000 行和 14 列,因此文本文件本身有 20 MB,超过这个我需要得到 D 列的值F 列中的值。 F 列中的值是唯一的。
到目前为止,我已经尝试过直接方法从 .txt 文件中提取数据并将其复制到 sheet,然后 运行 一个循环来获取附加值。
但是即使等待 15 分钟,代码也无法从 .txt 文件中提取数据。
Do While bContinue = True
outRow = 1
sInputFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If sInputFile = "False" Then
bContinue = False
Reset 'close any opened text file
Exit Sub
Else
outCol = outCol + 2
'process text file
fNum = FreeFile
Open sInputFile For Input As #fNum
Do While Not EOF(fNum)
outRow = outRow + 1
Line Input #fNum, sInputRecord
Sheets("Sheet1").Cells(outRow, outCol).Value = sInputRecord
Loop
Close #fNum
End If
Loop
errHandler:
Reset
End Sub
我预计它会花一些时间,但 运行 这段代码会花费很长时间,这会破坏使用宏的目的。 我只是请求是否有人有更好的方法来解决这个问题。
缺少代码的第一部分,但我猜你声明了变量。如果没有,那可能对性能有一点帮助。
您也可以尝试在进程开始时关闭计算,然后在结束时切换回来。
Application.Calculation = xlCalculationManual
'...
Application.Calculation = xlCalculationAutomatic
你说你只需要文本中的第 4 和第 6 列,但你将整行都放在一个单元格中。
如果您真的只想将一行的这两部分放入 sheet,您可能需要这样做:
With Sheets("Sheet1")
Do While Not EOF(fNum)
outRow = outRow + 1
Line Input #fNum, sInputRecord
.Cells(outRow, outCol).Value = Split(sInputRecord,";")(3)
.Cells(outRow, outCol+1).Value = Split(sInputRecord,";")(5)
Loop
End With
将分号更改为分隔符在 txt 文件中的任何字符。
请试试这个并反馈。
Sub TryMe()
Dim cN As ADODB.Connection '* Connection String
Dim RS As ADODB.Recordset '* Record Set
Dim sQuery As String '* Query String
On Error GoTo ADO_ERROR
cN = New ADODB.Connection
cN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\;Extended Properties=""text;HDR=Yes;FMT=Delimited(,)"";Persist Security Info=False"
cN.ConnectionTimeout = cN.Open()
RS = New ADODB.Recordset
sQuery = "Select * From VBA.csv ORDER BY ID"
RS.ActiveConnection = cN
RS.Source = sQueryRS.Open()
If RS.EOF <> True Then
While RS.EOF = False
Open "c:\temp\vba_sorted.csv" For Append As 1
Print #1, RS.Fields(0) & "," & RS.Fields(1); RS.MoveNext()
Close #1
End If
If Not RS Is Nothing Then RS = Nothing
If Not cN Is Nothing Then cN = Nothing
ADO_ERROR:
If Err <> 0 Then
Debug.Assert (Err = 0)
MsgBox (Err.Description)
Resume Next
End If
End Sub