VBA循环列运行Solver求解器无响应问题求助

核心问题分析 #

你的代码里连续调用了两次SolverSolve：

SolverSolve True
SolverSolve UserFinish:=True

这会让求解器重复初始化并执行任务，直接导致程序陷入无限等待状态，也就是你看到的"Preparing Problem"加载不结束的情况。

修正后的代码 #

Sub Solver1a()
    Dim c As Range
    Set c = ActiveSheet.Range("B11")
    Solver1b c
End Sub

Sub Solver1b(c As Range)
    Dim m As Long
    ' 确保Solver引用已启用
    On Error Resume Next
    If Not IsObject(Solver) Then
        MsgBox "请先启用Solver引用：VBA编辑器→工具→引用→勾选'Solver'"
        Exit Sub
    End If
    On Error GoTo 0
    
    For m = 1 To 3
        SolverReset
        
        ' 直接使用Range对象而非地址，避免活动表切换导致的引用错误
        SolverOk SetCell:=c, MaxMinVal:=3, ValueOf:=c.Offset(5, 0).Value, _
                ByChange:=c.Offset(3, 0), Engine:=1, EngineDesc:="Simplex LP"
        
        ' 只调用一次SolverSolve，用UserFinish:=True跳过弹窗
        SolverSolve UserFinish:=True
        SolverFinish KeepFinal:=1
        
        Set c = c.Offset(0, 1)
    Next m
End Sub

额外注意事项 #

• 启用Solver引用：打开VBA编辑器，点击「工具」→「引用」，找到并勾选Solver（通常是Solver.xlam对应的引用），否则代码会报错。
• 单元格引用验证：确认c、c.Offset(5,0)、c.Offset(3,0)对应的单元格确实是你需要的目标单元格、目标值单元格和可变单元格，避免引用空值或无效范围。
• 错误处理：如果某一列的求解出现异常，可以添加错误捕获逻辑，防止整个循环中断：

  For m = 1 To 3
      On Error Resume Next
      SolverReset
      ' ... 其他代码 ...
      SolverSolve UserFinish:=True
      If Err.Number <> 0 Then
          MsgBox "第" & m & "列求解失败：" & Err.Description
          Err.Clear
      End If
      On Error GoTo 0
      ' ... 后续代码 ...
  Next m
  

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