从已打开工作簿匹配检索数据的VBA代码开发求助

为什么之前的代码会崩溃？ #

逐行循环比对千行数据属于暴力匹配，时间复杂度是O(n²)，数据量上去后不仅运行极慢，还容易因内存占用过高或超时导致崩溃。用字典做快速查找是解决这类大数据量匹配问题的标准方案。

完整可运行代码 #

Sub MatchAndCopyData()
    Dim wbMain As Workbook, wbSecondary As Workbook
    Dim wsMain As Worksheet, wsSecondary As Worksheet
    Dim dict As Object
    Dim lastRowMain As Long, lastRowSec As Long
    Dim i As Long, matchKey As Variant
    
    ' ====== 这里改成你的实际文件/表名 ======
    Set wbMain = ThisWorkbook ' 主工作簿如果不是当前运行宏的文件，就改成Workbooks("你的主工作簿名.xlsx")
    Set wsMain = wbMain.Worksheets("主工作表名")
    ' 要么填完整路径，要么先打开二级工作簿再运行宏，把下面这句改成Set wbSecondary = Workbooks("二级工作簿名.xlsx")
    Set wbSecondary = Workbooks.Open("C:\你的二级工作簿完整路径.xlsx")
    Set wsSecondary = wbSecondary.Worksheets("二级工作表名")
    ' =====================================
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 先把二级工作簿的匹配数据装进字典
    lastRowSec = wsSecondary.Cells(wsSecondary.Rows.Count, "E").End(xlUp).Row
    For i = 2 To lastRowSec ' 假设第1行是表头，数据从第2行开始
        matchKey = wsSecondary.Cells(i, "E").Value
        If Not dict.Exists(matchKey) Then
            ' 把D、F-J列的数据打包成数组存进字典
            dict(matchKey) = Array(wsSecondary.Cells(i, 4).Value, _
                            wsSecondary.Cells(i, 6).Value, _
                            wsSecondary.Cells(i, 7).Value, _
                            wsSecondary.Cells(i, 8).Value, _
                            wsSecondary.Cells(i, 9).Value, _
                            wsSecondary.Cells(i, 10).Value)
        End If
    Next i
    
    ' 遍历主工作簿，匹配后批量写入数据
    lastRowMain = wsMain.Cells(wsMain.Rows.Count, "E").End(xlUp).Row
    For i = 2 To lastRowMain
        matchKey = wsMain.Cells(i, "E").Value
        If dict.Exists(matchKey) Then
            ' 一次性把6列数据写入，比逐列写快多了
            wsMain.Cells(i, 4).Resize(1, 6).Value = dict(matchKey)
        End If
    Next i
    
    ' 关闭二级工作簿（不需要保存就用False，要保存改True）
    wbSecondary.Close SaveChanges:=False
    
    ' 清理对象，释放内存
    Set dict = Nothing
    Set wsMain = Nothing
    Set wsSecondary = Nothing
    Set wbMain = Nothing
    Set wbSecondary = Nothing
    
    MsgBox "搞定！数据匹配复制完成", vbInformation
End Sub

关键说明 #

• 字典的作用：把二级工作簿E列的值作为“索引”，对应的数据存在字典里，查找时直接定位索引，避免了反复循环比对的低效操作，千行数据也能快速处理。
• 修改要点：代码里标了=====的部分必须改成你自己的文件路径和工作表名称，否则无法正常运行。
• 重复值处理：如果二级工作簿E列有重复值，字典只会保留最后一行的数据；若需处理重复场景，可以调整逻辑为用集合存储多组数据。
• 表头适配：如果你的数据没有表头，把循环起始的2改成1即可。

额外提醒 #

1. 运行宏前建议备份两份数据，避免因路径或表名写错导致数据异常。
2. 如果二级工作簿已经打开，可注释掉Workbooks.Open那行，换成Set wbSecondary = Workbooks("二级工作簿名.xlsx")。

内容的提问来源于stack exchange，提问作者Cortex9000