VBA嵌套For循环执行过慢求助：匹配两工作表数据并复制值

你的嵌套循环方案在数据量较大时会因为O(n*m)的时间复杂度导致执行缓慢，改用字典（Dictionary）存储匹配关系可将时间复杂度降至O(n+m)，大幅提升运行效率。以下是优化后的代码：

Sub ccopiazanrfact()
    Dim camion As Worksheet, facturi As Worksheet
    Dim factDict As Object
    Dim lastRowFact As Long, lastRowCamion As Long
    Dim i As Long
    Dim keyVal As Variant, matchVal As Variant
    
    ' 关闭不必要的Excel功能，进一步提速
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 初始化工作表对象
    Set camion = ThisWorkbook.Sheets("B816RUS")
    Set facturi = ThisWorkbook.Sheets("EVIDENTA FACTURI")
    Set factDict = CreateObject("Scripting.Dictionary") ' 创建字典实例
    
    ' 获取两个工作表的有效数据最后行号
    lastRowFact = facturi.Range("F" & Rows.Count).End(xlUp).Row
    lastRowCamion = camion.Range("E" & Rows.Count).End(xlUp).Row
    
    ' 将「EVIDENTA FACTURI」的F列（匹配键）和A列（目标值）存入字典
    For i = 2 To lastRowFact
        keyVal = facturi.Range("F" & i).Value
        ' 处理重复键：若F列有重复值，保留最后一行对应的A列内容
        If factDict.Exists(keyVal) Then
            factDict(keyVal) = facturi.Range("A" & i).Value
        Else
            factDict.Add keyVal, facturi.Range("A" & i).Value
        End If
    Next i
    
    ' 遍历「B816RUS」的E列，匹配字典并赋值到P列
    For i = 4 To lastRowCamion
        keyVal = camion.Range("E" & i).Value
        If factDict.Exists(keyVal) Then
            camion.Range("P" & i).Value = factDict(keyVal)
        End If
    Next i
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    ' 释放对象资源
    Set factDict = Nothing
    Set camion = Nothing
    Set facturi = Nothing
End Sub

优化细节说明 #

• 字典的核心优势：字典基于哈希表实现，键值对查找耗时可忽略，对比嵌套循环逐行匹配，数据量越大提速效果越显著。
• 额外提速配置：关闭屏幕更新、事件触发和自动计算，避免Excel在代码执行过程中做无意义的界面刷新或计算。
• 重复键处理逻辑：如果「EVIDENTA FACTURI」的F列存在重复值，代码默认保留最后一行对应的A列值，若需保留第一行，删除Else分支外的赋值语句即可。

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