文本匹配基于循环访问 excel 中的值，匹配具有 300 万行的 txt 文件中的值 [减慢速度]

Question

我有一些VBA代码可以循环遍历E列中的所有单元格，然后在文本文件中查找匹配项，并从txt文件中匹配的文本行中输入第一个单词。这有效，但是当我循环超过 10000 行时，需要 3 小时才能完成。

只是检查是否有更有效的方法可以做到这一点。加快进程。任何帮助将不胜感激

Sub SearchTextFile()
Dim x
Dim hex, reg As String
Dim strsearch As String
x = Sheet9.Range("Q1").Value
Dim hexa As String
Const strFileName = "T:HexHex_Codes.txt"
hex = Sheet9.Range("P1").Value
reg = Sheet1.Range("E" & x).Value
If Right(reg, 1) = "-" Then GoTo err
strsearch = hex
Dim strLine As String
Dim f As Integer
Dim lngLine As Long
Dim blnFound As Boolean
f = FreeFile
Open strFileName For Input As #f
Do While Not EOF(f)
lngLine = lngLine + 1
Line Input #f, strLine
If InStr(1, strLine, strsearch, vbBinaryCompare) > 0 Then
Text = Text & strLine
On Error GoTo err
Sheet1.Range("L" & x).Value = Format(Split(Text, ",")(0), "@")
blnFound = True
Exit Do
End If
Loop
Close #f
If Not blnFound Then
End If
err:
End Sub
Sub searchReg()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim lr1
lr1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Dim y
For y = 2 To lr1
Sheet9.Range("P1").Value = Sheet1.Range("E" & y).Value
Sheet9.Range("Q1").Value = y
Call SearchTextFile
Next y
Call verify_text_formulas
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Answer 1

我使用了从文本文件中读取的单个静态操作来避免重复的open.read/close调用。

通过将重要和必要的值作为参数/参数传递到 SearchTextFile 帮助程序中，我删除了将 Sheet8 用作值的保存/传输位置。

您没有提供有关verify_text_formulas的信息，因此当前已将其注释掉。

十六进制和注册似乎是一回事;六分之一从未使用过;文本从未声明过，似乎多余。我减少了无关变量的使用。

Option Explicit
Const cFileName As String = "T:HexHex_Codes.txt"
Sub SearchTextFile(Optional hex As String, _
                   Optional ln As Long = -1, _
                   Optional closeOff As Boolean = False)
    Static txt As String
    Dim ff As Integer, p As Long, ps As Long, str As String
    Dim blnFound As Boolean
    If txt = vbNullString Then
        'Debug.Print "new read"
        ff = FreeFile(1)
        Open cFileName For Binary As #ff
        txt = Space$(LOF(ff))
        Get #ff, , txt
        Close #ff
        txt = vbLf & txt
    End If
    If closeOff Then
        'Debug.Print "closed"
        txt = vbNullString
    Else
        p = InStr(1, txt, hex, vbBinaryCompare)
        If p > 0 Then
            ps = InStrRev(txt, vbLf, p, vbBinaryCompare)
            str = Chr(39) & Split(Mid(txt, ps + 1, p - ps + 1), ",")(0)
            Sheet1.Cells(ln, "L") = str
            blnFound = True
        End If
    End If
    If Not blnFound Then
    End If
err:
End Sub
Sub searchReg()
    Dim y As Long
    debug.print timer
    'Application.ScreenUpdating = False
    'Application.EnableEvents = False
    For y = 2 To Sheet1.Range("A" & Rows.Count).End(xlUp).Row
        SearchTextFile hex:=Sheet1.Cells(y, "E").Value, ln:=y
    Next y
    SearchTextFile closeOff:=True
    'Call verify_text_formulas
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    debug.print timer
End Sub

如果有机会，请回发各种记录集的一些计时器计数。这是在一个小（30 行）.TXT文件上测试的，但我会对处理较大文件所需的时间感兴趣。