三列匹配并复制粘贴数据：VBA代码运行缓慢问题求助

你的代码功能没问题，但慢的核心原因有两个：一是双重嵌套循环（Sheet3的每一行都要遍历Sheet2的所有行），数据量大时时间复杂度会爆炸；二是频繁读写单个单元格，Excel和VBA之间的对象交互开销非常高。下面是针对性的优化方案：

核心优化思路 #

• 把所有数据一次性读到内存数组中，避免反复读写单元格
• 使用字典（Dictionary）建立"三列组合键-目标值"的映射，把双层循环变成两次单层遍历，时间复杂度从O(n*m)降到O(n+m)
• 关闭Excel的屏幕更新、自动计算等，减少后台操作的干扰

优化后的完整代码 #

Sub OptimizedRowMatch()
    Dim ws As Worksheet, ws2 As Worksheet
    Dim dataSheet3 As Variant, dataSheet2 As Variant
    Dim matchDict As Object
    Dim i As Long, j As Long
    Dim key As String
    
    ' 初始化工作表对象
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    Set matchDict = CreateObject("Scripting.Dictionary")
    
    ' 关闭Excel的后台操作，大幅提升运行速度
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    On Error GoTo Cleanup ' 确保出错时能恢复Excel默认设置
    
    ' 1. 把Sheet3的目标数据一次性读到内存数组
    dataSheet3 = ws.Range(ws.Cells(3, 14), ws.Cells(ws.Cells(ws.Rows.Count, 14).End(xlUp).Row, 18)).Value
    
    ' 2. 构建字典：将三列组合成唯一键，对应要复制的第18列值
    For i = LBound(dataSheet3, 1) To UBound(dataSheet3, 1)
        ' 用特殊字符分隔三列内容，日期统一格式化避免匹配误差
        key = dataSheet3(i, 1) & "|" & dataSheet3(i, 2) & "|" & Format(dataSheet3(i, 3), "yyyy-mm-dd")
        ' 若存在重复键，默认保留最后一次出现的值，可按需调整为保留首次
        matchDict(key) = dataSheet3(i, 5) ' 数组第5列对应原Sheet3的第18列
    Next i
    
    ' 3. 把Sheet2的目标数据一次性读到内存数组
    dataSheet2 = ws2.Range(ws2.Cells(3, 98), ws2.Cells(ws2.Cells(ws2.Rows.Count, 98).End(xlUp).Row, 120)).Value
    
    ' 4. 遍历Sheet2数组，匹配字典并赋值
    For j = LBound(dataSheet2, 1) To UBound(dataSheet2, 1)
        key = dataSheet2(j, 1) & "|" & dataSheet2(j, 6) & "|" & Format(dataSheet2(j, 17), "yyyy-mm-dd")
        ' 数组索引对应：98列=第1列，103列=第6列，114列=第17列，120列=第23列
        If matchDict.Exists(key) Then
            dataSheet2(j, 23) = matchDict(key)
        End If
    Next j
    
    ' 5. 把处理后的数组一次性写回Sheet2
    ws2.Range(ws2.Cells(3, 98), ws2.Cells(UBound(dataSheet2, 1) + 2, 120)).Value = dataSheet2
    
Cleanup:
    ' 恢复Excel的默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    ' 释放占用的对象资源
    Set matchDict = Nothing
    Set ws = Nothing
    Set ws2 = Nothing
    
    ' 错误提示（如果有）
    If Err.Number <> 0 Then
        MsgBox "运行出错：" & Err.Description, vbExclamation
    End If
End Sub

关键细节说明 #

• 字典键的构建：用|作为分隔符避免内容拼接冲突，日期统一用yyyy-mm-dd格式，防止因显示格式不同导致匹配失败
• 数组索引对应：原工作表列号转数组索引时，要注意数组从1开始计数，比如Sheet3的14-18列对应数组的1-5列
• 错误防护：通过On Error GoTo Cleanup确保即使代码出错，Excel的屏幕更新、计算模式也能恢复，不会影响后续操作
• 重复键处理：如果Sheet3中有重复的三列组合，当前代码会保留最后一条记录的值，你可以根据需求修改为只保留首次出现的值

这样优化后，哪怕数据量上万行，运行速度也会提升几十甚至上百倍，再也不会出现未响应的情况了。

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