如何使用Excel VBA打开非常大的.dat文件

Question

I have some data files (.dat) that are very large (exceed the 1,048,000 rows Excel allows). I can't quite figure out what the problem is with the attempted macros (originally written for text files with "," delimiter, not .dat files with tab delimiter). The macro works, however it causes the data to be compiled into one column (ex. supposed to be 5 columns, now 1 column with all the numbers as a long text string). Is there a better way to open a very large .dat file, split it up and import it into separate worksheets while keeping the data in separate columns using the tab delimiter?

Sub ImportBigFile()
     Dim N As Long
     Dim Lim As Long
     Dim SS() As String
     Dim S As String
     Dim R As Long
     Dim C As Long
     Dim WS As Worksheet
     Dim FNum As Integer
     Dim FName As String

     FName = "C:\Folder 1\Folder 2\File.dat"
     FNum = FreeFile

     With ActiveWorkbook.Worksheets
         Set WS = .Add(after:=.Item(.Count))
     End With

     Lim = WS.Rows.Count
     Open FName For Input Access Read As #FNum
     R = 0
     Do Until EOF(FNum)
         R = R + 1
         Line Input #FNum, S
         SS = Split(S, "\t", -1)
         For C = LBound(SS) To UBound(SS)
             WS.Cells(R, C + 1).Value = SS(C)
         Next C
         If R = Lim Then
             With ActiveWorkbook.Worksheets
                 Set WS = .Add(after:=.Item(.Count))
             End With
             R = 0
         End If
     Loop
 End Sub

Answer 1

  SS = Split(S, "\t", -1)

should be

  SS = Split(S, chr$(9), -1)

Assuming your tab is ascii

Answer 2

This fixes 2 issues, and improves performance

1. As mentioned, the delimiter used in Split (vbTab)
2. You open the file for Input but never close it
3. Uses an array to convert to range format, then places it on the range in one operation

Test file used contains 3,145,731 Rows and 5 Cols (122 Mb)

• your code: 3.9 min (231.755 sec)
• this code: 1.1 Min ( 64.966 sec)

---

Option Explicit

Public Sub ImportBigFile2()
    Const fName = "C:\Folder 1\Folder 2\File.dat"
    Dim maxR As Long, maxC As Long, wsCount As Long, arr As Variant, rng As Variant
    Dim fNum As Long, fText As String, ws As Worksheet, ln As Variant, nextR As Long
    Dim i As Long, r As Long, c As Long, t As Double, ubArr As Long

    t = Timer:  fNum = FreeFile:    maxR = ThisWorkbook.Worksheets(1).Rows.Count
    Open fName For Input Access Read As #fNum
        fText = Input$(LOF(1), 1)
    Close #fNum

    arr = Split(fText, vbCrLf): ubArr = UBound(arr)
    maxC = UBound(Split(arr(0), vbTab)) + 1
    wsCount = ubArr \ maxR + 1: nextR = 0

    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets
        For i = 1 To wsCount
            Set ws = .Add(After:=.Item(.Count))
            ReDim rng(1 To maxR, 1 To maxC)
            For r = 1 To maxR
                ln = Split(arr(nextR), vbTab)
                For c = 1 To UBound(ln) + 1
                    rng(r, c) = ln(c - 1)
                Next
                nextR = nextR + 1:  If nextR > ubArr Then Exit For
            Next
            ws.Range(ws.Cells(1, 1), ws.Cells(maxR, maxC)) = rng
        Next
    End With
    Application.ScreenUpdating = True
    Debug.Print "Time: " & Format(Timer - t, "#,###.000") & " sec"  'Time: 64.966 sec
End Sub

---

Before (CSV file)

After