如何优化Excel宏代码运行速度？大行数场景下的性能提升方案

原宏处理7万行源数据、3万行目标数据时速度卡顿，核心问题出在逐行查找和逐行插入两个环节：

• 每次循环调用Range.Find都会遍历目标表A列，大数据量下重复遍历的时间成本呈指数级增长
• 逐行复制插入行时，Excel会频繁进行行重排、格式调整，交互开销极大

以下是针对性优化方案：

一、用字典实现O(1)快速匹配 #

把目标表（wsDest）A列的所有值提前加载到VBA字典中，后续判断源数据是否存在时，直接通过字典的Exists方法查询，时间复杂度从O(n)降到O(1)，彻底解决匹配慢的问题。

二、批量收集待插入行，一次性写入 #

先遍历源数据，把所有需要插入的行数据存入内存数组，最后一次性将数组内容写入目标表的指定位置，避免逐行插入的频繁交互开销。

三、关闭更多Excel后台消耗功能 #

除了ScreenUpdating，还要关闭事件触发（EnableEvents）和自动计算（Calculation），进一步减少Excel后台的资源占用。

完整优化代码 #

Sub OptimizedUpdate()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowSource As Long, lastRowDest As Long
    Dim dict As Object
    Dim i As Long, insertRowCount As Long
    Dim insertData As Variant
    Dim colCount As Integer, j As Integer
    
    ' 初始化字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    ' 绑定工作表
    Set wsSource = Workbooks("ExtractFile.xlsm").Worksheets("Sheet1")
    Set wsDest = Workbooks("Workbook.xlsm").Worksheets("Sheet1")
    
    ' 关闭Excel后台性能消耗项
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    ' 1. 预加载目标表A列数据到字典，用于快速查重
    lastRowDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowDest
        ' 避免重复键（如果有重复值只存第一个行号）
        If Not dict.Exists(wsDest.Cells(i, "A").Value) Then
            dict.Add wsDest.Cells(i, "A").Value, i
        End If
    Next i
    
    ' 2. 收集所有需要插入的源数据行到数组
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    colCount = wsSource.UsedRange.Columns.Count ' 获取源表有效列数
    ' 初始化数组，预留最大可能的行数
    ReDim insertData(1 To lastRowSource - 1, 1 To colCount)
    
    insertRowCount = 0
    For i = 2 To lastRowSource
        ' 判断当前行是否在目标表中不存在
        If Not dict.Exists(wsSource.Cells(i, "A").Value) Then
            insertRowCount = insertRowCount + 1
            ' 将整行数据存入数组
            For j = 1 To colCount
                insertData(insertRowCount, j) = wsSource.Cells(i, j).Value
            Next j
        End If
    Next i
    
    ' 3. 一次性写入所有待插入数据
    If insertRowCount > 0 Then
        ' 在目标表最后一行下方插入新数据
        wsDest.Cells(lastRowDest + 1, 1).Resize(insertRowCount, colCount).Value = insertData
    End If
    
    ' 恢复Excel默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    ' 保存并关闭源文件
    With Workbooks("ExtractFile.xlsm")
        .Save
        .Close
    End With
End Sub

优化说明 #

1. 字典查重：仅遍历目标表一次，后续查重操作几乎无耗时，对比原代码的7万次遍历，效率提升极其明显
2. 数组批量写入：把所有待插入数据先存在内存中，最后一次性写入Excel，避免了7万次复制插入的交互开销
3. 后台功能关闭：自动计算和事件触发在大数据操作时会频繁触发，关闭后能大幅减少资源占用

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