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

Question

我有一些非常大的数据文件（.dat）（超出Excel允许的1,048,000行）。 我无法完全弄清楚尝试使用的宏是什么问题（最初是为带有“，”分隔符的文本文件编写的，而不是为带有制表符分隔符的.dat文件编写的）。 该宏有效，但是它导致将数据编译为一列（例如，假定为5列，现在为1列，所有数字均为长文本字符串）。 有没有更好的方法来打开一个很大的.dat文件，将其拆分并导入到单独的工作表中，同时使用制表符分隔符将数据保留在单独的列中？

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)

应该

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

假设您的标签是ascii

Answer 2

此修复了2个问题，并提高了性能

1. 如前所述，分割（vbTab）中使用的定界符
2. 您打开文件进行输入，但从不关闭它
3. 使用数组转换为范围格式，然后通过一次操作将其放在范围上

使用的测试文件包含3,145,731行和5个列（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

---

之前（CSV文件）

后