如何提升Excel VBA中Sumifs函数的运行效率？循环调用多次耗时约3分钟问题求解

阿华AIGC实验室

2026-4-30

如何加快Excel VBA中SumIfs的运行速度

哇，3分钟的耗时确实有点离谱，尤其是只执行10次这类操作的情况下。咱们来针对性优化你的代码，把速度拉上来！下面是几个关键优化点，结合你的代码来改：

1. 先关闭Excel的「后台消耗」功能

每次循环写入单元格时，Excel都会自动刷新屏幕、重新计算公式，这些操作非常耗时间。在代码开头先把这些功能关掉，结束后再恢复：

' 开头添加
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False ' 如果没用到工作表事件，也可以关掉

' 你的核心代码...

' 结尾恢复
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

2. 别用整列范围！用实际数据区域

你现在用的是Range("H:H")、Range("B:B")这类整列范围，SumIfs会被迫处理100多万行（包括大量空行），这会浪费大量时间。先找到数据源的实际最后一行，缩小处理范围：

Dim wkLastRow As Long
With wk.Worksheets(1)
    ' 假设B列是数据的关键列，以此找最后一行
    wkLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    Set cari_total = .Range("H2:H" & wkLastRow)
    Set Arg1 = .Range("B2:B" & wkLastRow)
    Set Arg2 = .Range("N2:N" & wkLastRow)
    Set Arg3 = .Range("C2:C" & wkLastRow)
End With

3. 用字典预处理数据，避免循环调用SumIfs

每次循环调用SumIfs都会重新遍历一遍数据源，这是最大的性能杀手。我们可以先把符合Arg2="SBK"和Arg3="0110"的数据按Arg1分组求和，存在字典里，之后循环直接从字典取值：

Dim sumDict As Object
Set sumDict = CreateObject("Scripting.Dictionary")

' 遍历数据源，预处理求和
Dim j As Long
With wk.Worksheets(1)
    For j = 2 To wkLastRow
        ' 先判断是否符合固定条件
        If .Cells(j, "N").Value = "SBK" And .Cells(j, "C").Value = "0110" Then
            Dim key As Variant
            key = .Cells(j, "B").Value
            ' 累加对应key的求和值
            If sumDict.Exists(key) Then
                sumDict(key) = sumDict(key) + .Cells(j, "H").Value
            Else
                sumDict(key) = .Cells(j, "H").Value
            End If
        End If
    Next j
End With

然后把原来的循环改成直接从字典取值，还可以把结果先存到数组里再一次性写入（单元格IO操作是出了名的慢，批量写入能大幅提速）：

' 直接获取目标工作表，别用Activate操作
Dim ws As Worksheet
Set ws = Workbooks("report_4UD.xlsm").Worksheets(1)

' 准备结果数组，对应C2到C[lRow]的范围
Dim resultArr As Variant
ReDim resultArr(1 To lRow - 1, 1 To 1)

For i = 2 To lRow
    Crt1 = ws.Range("A" & i).Value
    ' 从字典取数，不存在则返回0
    resultArr(i - 1, 1) = IIf(sumDict.Exists(Crt1), sumDict(Crt1), 0)
Next

' 一次性写入单元格，比循环逐行写快N倍
ws.Range("C2:C" & lRow).Value = resultArr