vba - 求解器在我第二次运行时不起作用

Question

下面的代码在我第一次运行时完美运行，

但是当我第二次或第三次再次运行它时

它给了我一个来自求解器的 msgbox，告诉它找到了解决方案，然后当我单击选择 OK
它只是退出子。不明白为什么。

我也想知道如何给OK通过 vba 从 Solver 对话框中向提示发出命令？或者只是简单地避免它。

Option Explicit
Sub MinimizeCost()

Dim wm, ws, wr As Worksheet
Dim i, j, FinalRow As Long
Dim char As Variant
Dim ScnCap, ScnDem As Range

Set wm = Sheets("Model")
Set ws = Sheets("Scenarios")
Set wr = Sheets("Results")

For i = 1 To 5

With ws
 j = i + 1
  Set ScnCap = .Range(.Cells(5, j), .Cells(7, j))
End With

wm.Range("Capacities") = ScnCap.Value

With ws
 j = i + 1
  Set ScnDem = .Range(.Cells(10, j), .Cells(13, j))
End With

ScnDem.Copy
wm.Range("Demands").PasteSpecial Transpose:=True

Call Solveit

FinalRow = wr.Range("A9000").End(xlUp).Row
FinalRow = FinalRow + 1

wr.Range("A" & FinalRow + 1) = "Scenario" & " " & i
wr.Range("A" & FinalRow + 2) = "Shipments"
wr.Range("F" & FinalRow + 2) = "Total Cost"

wm.Range("TotalCost").Copy
wr.Range("F" & FinalRow + 3).PasteSpecial xlPasteValues

wm.Range("Shipped").Copy
wr.Range("A" & FinalRow + 3).PasteSpecial xlPasteValues

SendKeys ("{ESC}")
wm.Range("A1").Select
Next i 
End Sub

Sub Solveit()

Dim wk As Worksheet
Set wk = Sheets("Model")
wk.Select
    SolverOk SetCell:="$B$20", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$13:$F$15", _
        Engine:=2, EngineDesc:="Simplex LP"
    SolverOk SetCell:="$B$20", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$13:$F$15", _
        Engine:=2, EngineDesc:="Simplex LP"
    SolverSolve

End Sub

Answer 1

在 microsoft website ，它解释了有关 Excel-VBA 中的 sovler 的一切。更换您的 SolverSolve逐行

SolverSolve UserFinish:=True

应该避免 msgBox 在最后弹出。

关于错误的二次运行解决方案的问题，我建议添加 SolverReset在 Solveit() 的开头功能。如解释 here ，它将导致单元格选择重置，这在多次运行求解器时可能会出现问题。
而且，你不应该有 2 SolverOk在求解器中设置，特别是如果它们具有完全相同的属性...
最后，这样的事情应该可以完成:

Sub Solveit()

Dim wk As Worksheet
Set wk = Sheets("Model")
wk.Select

SolverReset
SolverOk SetCell:="$B$20", MaxMinVal:=2, ValueOf:=0, _
    ByChange:="$C$13:$F$15", Engine:=2, EngineDesc:="Simplex LP"
SolverSolve UserFinish:=True

End Sub

顺便说一句，请注意以下语句:

wm.Range("Shipped").Copy
wr.Range("A" & FinalRow + 3).PasteSpecial xlPasteValues

VBA 处理复制/粘贴非常糟糕，如果您只想将一个单元格的值复制到另一个单元格(也适用于 Range，因为它们具有相同的尺寸)，只需编写:

wr.Range("A" & FinalRow + 3).value = wn.Range("Shipped").value

这将使您的代码更易于调试并且运行速度更快。