如何使用 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. 如前所述，Split (vbTab) 中使用的分隔符
2. 您为 Input 打开文件但从不关闭它
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 文件）

之后