如何加速循环调用Solver的VBA求解代码？

下面是针对你的VBA代码的关键优化点，能大幅减少处理450个单元格的耗时：

1. 移除重复的Solver调用 #

原代码连续调用两次SolverSolve，属于完全冗余操作，直接砍掉其中一个即可减少一半的Solver运行次数。

2. 避免累积约束条件 #

每次循环调用SolverAdd会新增一条约束，循环100次后就会堆积99条额外约束，导致Solver每次运行都要处理越来越多的规则。解决方法是在每次循环前重置Solver，清除所有旧约束后再添加当前所需的单条约束。

3. 优化变量与单元格读取 #

• 显式声明所有变量，避免变体类型的性能开销
• 将循环中不会改变的值（如mytarget、$O$8）移到循环外读取，减少重复访问单元格的次数
• 引用具体工作表对象，避免依赖ActiveSheet带来的潜在性能损耗

4. 禁用更多Excel后台操作 #

除了自动计算和屏幕更新，禁用事件处理也能减少额外的系统开销。

优化后的完整代码 #

Sub OptimizedSolve()
    Dim i As Integer
    Dim mytarget As Double
    Dim constraintVal As Variant
    Dim ws As Worksheet
    
    ' 绑定目标工作表（替换为你的实际表名）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 一次性禁用Excel后台操作
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 读取固定参数，仅执行一次
    mytarget = ws.Range("$C$10").Value
    constraintVal = ws.Range("$O$8").Address
    
    For i = 16 To 450 ' 调整为需要处理的450个单元格范围
        ' 重置Solver并清除所有旧约束
        SolverReset
        
        ' 设置当前迭代的Solver规则
        SolverAdd CellRef:=ws.Range("$J$" & i), Relation:=1, FormulaText:=constraintVal
        SolverOk SetCell:=ws.Range("$P$" & i), MaxMinVal:=3, ValueOf:=mytarget, _
            ByChange:=ws.Range("$J$" & i).Address, Engine:=1, EngineDesc:="GRG Nonlinear"
        
        ' 单次调用完成求解
        SolverSolve userFinish:=True
        SolverFinish KeepFinal:=1
    Next i
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    Set ws = Nothing
End Sub

额外提速建议 #

• 如果你的问题属于线性规划场景，将Solver引擎切换为Engine:=2（线性引擎）会比GRG Nonlinear快很多
• 确保$P$i列的计算公式尽可能简洁，减少Solver迭代时的计算量

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