循环求解器 VBA

Loop With Solver VBA

提问by Mary

Hi I have the following code which runs a single optimisation through solver which I would like to run in a loop. the single run code is:

嗨，我有以下代码，它通过我想循环运行的求解器运行单个优化。单次运行代码是：

    Sub Macro4
SolverReset
    SolverOk SetCell:="$D", MaxMinVal:=2, ValueOf:="0", ByChange:="$D:$R"
    SolverAdd CellRef:="$S", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D:$R", Relation:=1, FormulaText:="$D:$R"
    SolverAdd CellRef:="$D:$R", Relation:=3, FormulaText:="$D:$R"
    SolverAdd CellRef:="$D", Relation:=2, FormulaText:="$D"
    SolverOk SetCell:="$D", MaxMinVal:=2, ValueOf:="0", ByChange:="$D:$R"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41").Select
    ActiveSheet.Paste
    Range("D36").Select

Application.CutCopyMode = False
Selection.Copy
Range("F41").Select
ActiveSheet.Paste
Range("D36").Select


Range("D7:R7").Select
Application.CutCopyMode = False


   Selection.Copy
    Range("I41").Select
    ActiveSheet.Paste
End Sub

The solver optimises to a value in $D$41 (amongst other constraints)and then pastes the solutions by copying a couple of individual cells and an array and then pasting them alongside the original target cell (i.e. into row 41.) This works well. However I am trying to get it to run for a column of target cells by getting it to optimise to each cell in the column in turn, by using a loop (or better alternative), before pasting the solutions alongside it as it does for the single run code. For example I am trying to merge it with the following code

求解器优化为 $D$41 的值（以及其他约束），然后通过复制几个单独的单元格和一个数组来粘贴解决方案，然后将它们粘贴到原始目标单元格旁边（即到第 41 行）。这很好用。但是，我试图通过使用循环（或更好的替代方法）依次优化列中的每个单元格，然后将解决方案粘贴到它旁边，就像它为单次运行代码。例如，我试图将它与以下代码合并

    Sub Complete()
'
'
'
Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

    For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count
    Next Count
End Sub

which generates the column of target values (from strt to fnsh using increment) for Solver to take and use instead of (I think!!!) the part that says FormulaText:="$D$41". However I run into various errors and complaints (method 'Range' of Object'_Global'failed- which highlights the line "Range(E41+Count").Select. The complete code I have is:

它生成目标值列（从 strt 到 fnsh 使用增量），供求解器采用和使用而不是（我认为！！！）说FormulaText:="$D$41". 但是我遇到了各种错误和投诉（Object'_Global'的方法'Range'失败-突出显示了“Range（E41 + Count”）行。选择。我拥有的完整代码是：

`Sub Macro5()
   Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count

    SolverReset
    SolverOk SetCell:="$D", MaxMinVal:=2, ValueOf:="0", ByChange:="$D:$R"
    SolverAdd CellRef:="$S", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D:$R", Relation:=1, FormulaText:="$D:$R"
    SolverAdd CellRef:="$D:$R", Relation:=3, FormulaText:="$D:$R"
    SolverAdd CellRef:="$D", Relation:=2, FormulaText:="$D:$D+Count"
    SolverOk SetCell:="$D", MaxMinVal:=2, ValueOf:="0", ByChange:="$D:$R"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41+Count").Select
    ActiveSheet.Paste
    Range("D36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F41+Count").Select
    ActiveSheet.Paste

    Range("D7:R7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("I41+Count").Select
    ActiveSheet.Paste

Next Count 
End Sub` 

I just need it to update which cell it is optimising to (and putting it in the constraint of solver), then updating which cells to copy and where to paste them. Any help would be greatly appreciated.

我只需要它来更新它正在优化的单元格（并将其置于求解器的约束中），然后更新要复制的单元格以及粘贴它们的位置。任何帮助将不胜感激。

回答by Dick Kusleika

Range("E41+Count").Select

This is improper syntax. The following is preferred:

这是不正确的语法。以下是首选：

Range("E41").Offset(Count,0).Select

or you could use

或者你可以使用

Range("E" & 41 + Count).Select

In general, avoid using Range without the sheet name in front of it. Also, only Select when you need to, and that's almost never. Here's an example that doesn't use any Select methods.

通常，避免使用前面没有工作表名称的 Range。此外，仅在需要时才选择，而且几乎从来没有。这是一个不使用任何 Select 方法的示例。

Sub Complete()

    Dim lStrt As Long, lFnsh As Long
    Dim lCount As Long, lCount2 As Long
    Dim lIncrement As Long

    For lCount = lStrt To lFnsh Step lIncrement
        lCount2 = lCount / lIncrement

        Sheet1.Range("D41").Offset(lCount2, 0).Value = lCount

        SolverReset
        SolverOk SetCell:="$D", MaxMinVal:=2, ValueOf:="0", ByChange:="$D:$R"
        SolverAdd CellRef:="$S", Relation:=2, FormulaText:="1"
        SolverAdd CellRef:="$D:$R", Relation:=1, FormulaText:="$D:$R"
        SolverAdd CellRef:="$D:$R", Relation:=3, FormulaText:="$D:$R"
        SolverAdd CellRef:="$D", Relation:=2, FormulaText:=Sheet1.Range("D41").Offset(lCount2, 0).Address
        SolverOk SetCell:="$D", MaxMinVal:=2, ValueOf:="0", ByChange:="$D:$R"
        SolverSolve UserFinish:=True
        SolverFinish KeepFinal:=1

        Sheet1.Range("E41").Offset(lCount2, 0).Value = Sheet1.Range("D37").Value
        Sheet1.Range("F41").Offset(lCount2, 0).Value = Sheet1.Range("D36").Value
        Sheet1.Range("D7:R7").Copy Sheet1.Range("I41").Offset(lCount2, 0)

    Next lCount

End Sub

回答by Kazimierz Jawor

Lets take into consideration part of the first line from your base solver code. There is:

让我们考虑基本求解器代码中第一行的一部分。有：

SolverOk SetCell:="$D" 'and so on...

Wherever you have any address in Solver parameters you should pass there address instead of value (which could be quite intuitive but its not working). Therefore you would do something like this:

无论您在 Solver 参数中有任何地址，您都应该传递地址而不是值（这可能非常直观，但它不起作用）。因此，你会做这样的事情：

SolverOk SetCell:=Range("$D").Address '... structure ok

but not:

但不是：

SolverOk SetCell:=Range("$D").Value   '... wrong structure

Than you need to improve your loop in that direction. If it doesn't help you please provide complete code of what you have.

比你需要在那个方向上改进你的循环。如果它对您没有帮助，请提供您所拥有的完整代码。