如何提升VBA宏中MAXIFS公式的执行效率？

基础性能优化（必做） #

先关闭Excel的后台开销项，执行完再恢复，这是通用的提速手段：

• 关闭屏幕更新
• 禁用事件触发
• 设置手动计算

代码示例：

' 保存原设置
Dim origScreenUpdating As Boolean
Dim origEnableEvents As Boolean
Dim origCalculation As XlCalculation

origScreenUpdating = Application.ScreenUpdating
origEnableEvents = Application.EnableEvents
origCalculation = Application.Calculation

' 关闭不必要的功能
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

' --- 你的核心计算代码放在这里 ---

' 恢复原设置
Application.ScreenUpdating = origScreenUpdating
Application.EnableEvents = origEnableEvents
Application.Calculation = origCalculation

替换公式为数组内存计算（大幅提速） #

原代码用公式填充再转值，本质还是Excel逐个计算公式。改用数组读取数据到内存，用VBA逻辑计算MAXIFS，再批量写回单元格，速度会快很多，尤其是数据量大时。

代码示例：

Sub FastMaxIFS()
    ' 基础优化设置
    Dim origScreenUpdating As Boolean, origEnableEvents As Boolean, origCalculation As XlCalculation
    origScreenUpdating = Application.ScreenUpdating: Application.ScreenUpdating = False
    origEnableEvents = Application.EnableEvents: Application.EnableEvents = False
    origCalculation = Application.Calculation: Application.Calculation = xlCalculationManual
    
    ' 提前定义工作表，避免重复调用
    Dim wsDest As Worksheet, wsMC As Worksheet
    Set wsDest = Workbooks(modelo).Sheets(NomeAba)
    Set wsMC = ThisWorkbook.Sheets("matriz_de_custos") ' 按需调整工作簿引用
    
    ' 获取行号
    Dim ultimaLinhaDest As Long, ultimaLinhaMC As Long
    ultimaLinhaDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
    ultimaLinhaMC = wsMC.Cells(wsMC.Rows.Count, "P").End(xlUp).Row
    
    ' 读取matriz_de_custos的条件列和值列到内存数组
    Dim arrMC As Variant
    arrMC = wsMC.Range("D2:D" & ultimaLinhaMC & ",L2:L" & ultimaLinhaMC & ",U2:U" & ultimaLinhaMC & ",P2:P" & ultimaLinhaMC).Value
    ' 数组列顺序：D(1), L(2), U(3), P(4)
    
    ' 读取目标工作表的条件列（对应原公式的RC[-18], RC[-17], RC[-12]）
    Dim arrDestCond As Variant
    arrDestCond = wsDest.Range("D5:D" & ultimaLinhaDest & ",E5:E" & ultimaLinhaDest & ",J5:J" & ultimaLinhaDest).Value
    ' 数组列顺序：D(1), E(2), J(3)
    
    ' 初始化结果数组
    Dim arrResult As Variant
    ReDim arrResult(1 To UBound(arrDestCond, 1), 1 To 1)
    
    ' 遍历计算最大值
    Dim i As Long, j As Long, currentMax As Double
    For i = 1 To UBound(arrDestCond, 1)
        currentMax = 0 ' 默认值0
        For j = 1 To UBound(arrMC, 1)
            ' 匹配三个条件
            If arrMC(j, 1) = arrDestCond(i, 3) And arrMC(j, 2) = arrDestCond(i, 1) And arrMC(j, 3) = arrDestCond(i, 2) Then
                If arrMC(j, 4) > currentMax Then currentMax = arrMC(j, 4)
            End If
        Next j
        arrResult(i, 1) = currentMax
    Next i
    
    ' 批量写回结果到V列
    wsDest.Range("V5:V" & ultimaLinhaDest).Value = arrResult
    
    ' 恢复原设置
    Application.ScreenUpdating = origScreenUpdating
    Application.EnableEvents = origEnableEvents
    Application.Calculation = origCalculation
End Sub

其他细节优化 #

• 提前引用工作表对象：避免重复调用Workbooks(modelo).Sheets(NomeAba)，减少Excel对象模型的访问开销
• 缓存静态数据：如果matriz_de_custos的数据在多次执行中不变，可以把数组arrMC放在模块级变量中，不用每次都重新读取
• 避免整列引用：始终用实际最后一行的范围，不要用整列（比如Range("P:P")），减少不必要的数据读取

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