vba - 将大量文本转储到数组中的更快方法

Question

我有一个包含大约 6GB 数据的 .txt。以分号分隔的字段。

我需要根据预建字典逐行检查其中一个字段，如果匹配，则将相应行的所有字段复制到二维数组中。

目前这是代码的相关部分(省略了声明和函数。不在这个问题的范围内):

Set hbDict = dict_HB(hb) ''--this returns a dictionary from a function for comparison

Set FSO = CreateObject("scripting.filesystemobject")
Set myFile = FSO.OpenTextFile(sPath & sFilename, ForReading)

'--This counts how many matches occur between txt and dictionary to redim the array:
Do While myFile.AtEndOfStream <> True
    textline = myFile.ReadLine
    arrLine = Split(textline, ";")
    If hbDict.exists(arrLine(3)) Then
        arrLimit = arrLimit + 1
    End If
Loop

Redim MyArray(1 to arrLimit, 1 to 31)

'--Loop again through the file, now actually adding to the redimmed array:
L = 1
Do While myFile.AtEndOfStream <> True
    textline = myFile.ReadLine
    arrLine = Split(textline, ";")
    If hbDict.exists(arrLine(3)) Then
        For c = 1 to 31
            MyArray(L,C) = arrLine(c-1)
        Next
        L = L + 1
    End If
Loop
myFile.Close
set FSO = nothing

'code continues...

第一个循环大约需要 19 分钟。再多一点。

已经尝试打开追加，但它崩溃了，可能是因为我在 4gb 的 RAM 上运行。一次加载整个文件的任何方式似乎都会使机器崩溃。打开输入不会读取整个文件，因此数据会丢失。如果它可以处理超过 256 个条目，那么在第一个循环中使用集合来避免重新循环 txt 会很棒......当然，循环内的动态 redim 数组是毫无疑问的，因为它是性能 killer 。

有没有比这更快的方法？

Answer 1

将第一个循环改为

Dim colLines As Collection
Set colLines = New Collection
    Do While Not myFile.AtEndOfStream
        textline = myFile.ReadLine
        arrLine = Split(textline, ";")
        If hbDict.exists(arrLine(3)) Then
            'arrLimit = arrLimit + 1
            colLines.Add textline
        End If
    Loop

第二个循环

Dim i As Long
ReDim MyArray(1 To colLines.Count, 1 To 31)

For i = 1 To colLines.Count
    textline = colLines(i)
    arrLine = Split(textline, ";")
    If hbDict.exists(arrLine(3)) Then
        For c = 1 To 31
            MyArray(L, c) = arrLine(c - 1)
        Next
        L = L + 1
    End If
Next i

这样你只需要读取一次文本文件。因为它太大了，您将无法将文件完全读入内存。