如何优化通过VBA从excel中的超大文本文件提取数据的性能

Question

I want to get data regarding the value against a key cell value in a row. The problem is that the file is really big, I have a .txt file that has around 54000 rows and 14 columns so as such the text file itself is of 20 mb, and over that I need to get the value of D column against the value in F column. The values in column F are unique.

I have tried the direct approach till now to pull the data from .txt file and copy it to the sheet and then run a loop to get the attached value.

But the code is not able to pull data from the .txt file even after waiting for 15 minutes.

  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

I expected it to take some time but it is taking forever to run this code which kills the purpose of using the macro. I just request if someone has a better way to solve this issue.

Answer 1

The first part of the code is missing but I guess you declared variables. If not, that might help a little on performance.

You can also try switching off calculations at the beginning of the process then switch them back in the end.

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

You are saying that you only need the 4th and 6th column from the text but you put the whole line into a cell.

If you really want to put only those two parts of a line into the sheet, you might want to do something like this:

 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

Change the semicolon to whatever character the separator is in the txt file.

Answer 2

Pleases try this and feed back.

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