VBA多变量Solver GoalSeek千行批量循环的代码合并问题

' 运行前请先确保已勾选VBA引用中的Solver库
Sub goal_seek()
    Dim r As Long
    ' 关闭屏幕更新可大幅提升批量运行速度，不需要可删除该行
    Application.ScreenUpdating = False
    
    For r = 4 To 1004
        ' 每次重置Solver参数，避免上一行的配置残留干扰当前求解
        SolverReset
        ' 动态绑定当前行的求解单元格与可变单元格
        SolverOk SetCell:="$AR$" & r, _
                 MaxMinVal:=2, _
                 ValueOf:=0, _
                 ByChange:="$H$" & r & ":$K$" & r, _
                 Engine:=1, _
                 EngineDesc:="GRG Nonlinear"
        ' 执行求解，UserFinish:=True会跳过弹窗提示，需要查看求解状态可删除该参数
        SolverSolve UserFinish:=True
    Next r
    
    Application.ScreenUpdating = True
    MsgBox "1000行批量求解完成"
End Sub

注意事项 #

• 首次运行前必须先启用Solver引用：按下Alt+F11打开VBA编辑器，点击顶部菜单「工具」→「引用」，在列表中找到「Solver」勾选后点击确认，否则会触发编译错误。
• 代码完全复用你已实现的差值计算逻辑，直接以每行AR列的差值总和最小化到0为目标，调整对应行H-K列的4个变量，符合你的需求。
• 若部分行求解结果不符合预期，可去掉SolverSolve后的UserFinish:=True参数，运行时会逐行弹出求解状态报告，方便定位异常行。
• 批量运行期间Excel会处于无响应状态属于正常现象，等待结束提示弹窗即可。

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