如何優化通過VBA從excel中的超大文本文件提取數據的性能

Question

我想獲取有關該值對一行中的關鍵單元格值的數據。 問題是該文件確實很大，我有一個.txt文件，該文件有大約54000行和14列，因此文本文件本身的大小為20 mb，並且我需要獲取D列的值作為對F列中的值。 F列中的值是唯一的。

到目前為止，我一直嘗試直接方法從.txt文件中提取數據並將其復制到工作表中，然后運行循環以獲取附加值。

但是，即使等待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

我預計這將花費一些時間，但是運行該代碼將花費很多時間，這扼殺了使用宏的目的。 我只是問是否有人有更好的方法來解決這個問題。

Answer 1

代碼的第一部分丟失了，但是我想您已經聲明了變量。 如果沒有，那可能會對性能有所幫助。

您也可以嘗試在流程開始時關閉計算，然后在最后將其重新切換。

Application.Calculation = xlCalculationManual
'...
Application.Calculation = xlCalculationAutomatic

您說的是，只需要文本中的第4列和第6列，但是您將整行都放在了一個單元格中。

如果您確實只想將行的這兩部分放入工作表中，則可能需要執行以下操作：

 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文件中分隔符的任何字符。

Answer 2

請嘗試一下並反饋。

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