求解器在我第二次运行时不起作用答案

【问题标题】：Solver Doesn't works for the second time when I run it求解器在我第二次运行时不起作用
【发布时间】：2015-10-24 22:32:18
【问题描述】：

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

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

它给了我一个来自求解器的消息框，告诉它找到了解决方案，然后当我点击选择OK

它只是从 Sub 中退出。不明白为什么。

我还想知道如何通过 vba 从 Solver 对话框中将 OK 命令提供给提示符？或者干脆避免它。

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

【问题讨论】：

标签： vba excel solver

【解决方案1】：

在microsoft website 上，它解释了有关 Excel-VBA 中的 sovler 的所有内容。用

替换您的 SolverSolve 行

SolverSolve UserFinish:=True

应该避免最后弹出msgBox。

关于二次运行错误的问题，我建议在Solveit()function 的开头加上SolverReset。正如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

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

【讨论】：