VBA数组公式刷新代码陷入无限计算循环，求解决办法

我之前也踩过一模一样的坑！你的代码陷入无限循环，核心原因是Excel的自动计算机制会在公式更新后立刻触发重新计算，而你的代码又在遍历刷新公式，相当于不断触发「计算→刷新→计算」的死循环。下面给你两个经过验证的解决方案：

方案1：临时禁用自动计算与事件触发 #

这是最直接有效的办法，在代码执行期间关闭Excel的自动计算和工作表事件，避免循环触发，执行完成后再恢复原有设置。

修改后的完整代码：

Sub RefreshAllFormulas()
    Dim i As Integer
    Dim CurCell As Range
    Dim lastCellFx As Range
    Dim Total As Long, Subtotal As Long
    
    ' 保存原有设置，后续必须恢复
    Dim originalCalc As XlCalculation
    Dim originalEvents As Boolean
    originalCalc = Application.Calculation
    originalEvents = Application.EnableEvents
    
    On Error GoTo Cleanup ' 确保出错时也能恢复设置，避免Excel状态异常
    
    ' 禁用自动计算和事件触发，从根源阻止循环
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    MousePointer = fmMousePointerHourGlass
    
    Total = 0
    For i = 1 To ActiveWorkbook.Sheets.Count
        Subtotal = 0
        On Error Resume Next ' 跳过无数组公式的工作表，避免报错
        ' 直接定位数组公式单元格，不用遍历所有单元格，效率飙升
        For Each CurCell In ActiveWorkbook.Sheets(i).Cells.SpecialCells(xlCellTypeFormulas, xlArray)
            ' 重新输入数组公式，实现刷新效果
            CurCell.FormulaArray = CurCell.FormulaArray
            Subtotal = Subtotal + 1
        Next CurCell
        On Error GoTo 0
        Total = Total + Subtotal
    Next i
    
    ' 手动触发一次全量计算，确保所有公式更新完成
    Application.Calculate
    
Cleanup:
    ' 恢复Excel原有设置，这一步非常重要！
    Application.Calculation = originalCalc
    Application.EnableEvents = originalEvents
    MousePointer = fmMousePointerDefault
    MsgBox "共刷新 " & Total & " 个数组公式单元格", vbInformation
End Sub

关键改进点：

• 保存并恢复Excel的Calculation和EnableEvents设置，避免影响后续正常操作
• 用SpecialCells(xlCellTypeFormulas, xlArray)直接定位数组公式单元格，不用遍历所有单元格，既高效又减少不必要的触发
• 增加错误处理分支，确保即使代码中途出错，也能恢复Excel的正常状态

方案2：检查计算状态，避免重复触发 #

如果你不想完全禁用自动计算，可以在代码开头加入判断，只在Excel处于非计算状态时执行刷新：

Sub RefreshAllFormulasSafe()
    ' 先判断Excel是否正在计算，避免嵌套触发循环
    If Application.CalculationState <> xlDone Then Exit Sub
    
    ' 后续逻辑和方案1类似，这里省略重复部分...
End Sub

这个方法适合场景更复杂的情况，但稳定性不如方案1，优先推荐方案1。

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