求解器运行时不能再次运行

下面的代码在第一次运行的时候是完美的,

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

它给了我一个msgbox这是从求解器告诉它find了解决scheme,然后当我点击OK

它只是退出小组。 不明白为什么。

另外我想知道如何给通过vba求解对话框的提示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 

在微软网站上 ,它解释了在Excel-VBA中关于sovler的一切。 通过replace您的SolverSolve

 SolverSolve UserFinish:=True 

应该避免在最后popupmsgBox。

在关于错误的第二运行解决scheme的问题上,我build议在Solveit()函数开始时添加SolverReset 。 正如这里所解释的,这将导致单元select重置,这在多次运行求解器时可能是一个问题。 而且,你也不应该在求解器中设置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处理复制/粘贴相当糟糕,只写:

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

这将使您的代码更清晰地进行debugging,运行速度更快。