使用求解器 VBA 循环答案

【问题标题】：Loop With Solver VBA使用求解器 VBA 循环
【发布时间】：2013-03-08 01:33:16
【问题描述】：

您好，我有以下代码通过求解器运行单个优化，我想在循环中运行。单次运行代码为：

    Sub Macro4
SolverReset
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    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

求解器优化到 $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

它生成目标值列（从 strt 到 fnsh 使用增量）供 Solver 获取和使用，而不是（我认为!!!）说 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$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41:$D$41+Count"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    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`

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

【问题讨论】：

你的脚本在它周围有什么样的循环？您遇到的确切错误是什么以及在哪些行中？您是否查看过错误并尝试纠正它们？你有没有试过用代码把“$D$41”改成别的东西，那是什么样子的？
我收到诸如“编译错误：预期语句结束”之类的错误。但是现在完整的代码只说对象'_global'的方法'范围'失败并突出显示 RangeXXX.Select 代码，我认为它与我尝试将其粘贴到正确的单元格中的方式有关。我已经用新代码更新了问题。
您应该在调试模式下运行代码，这样您就可以看到它落在哪一行以及哪些变量具有预期值以外的值。通过选择您开始的第一个 sub 的 Sub xxx 行来执行此操作，然后按 F9，现在它将有一个彩色背景和一个项目符号在它前面。当您现在触发代码的开始时，它将停在那里。使用 F8，您可以逐行浏览代码。通过鼠标悬停，您可以检查所有变量的值。此外，建议激活本地监视窗口以查看所有局部变量和对象。
会的。感谢您的提示。

标签： loops excel solver vba

【解决方案1】：

Range("E41+Count").Select

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

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

或者你可以使用

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

一般来说，避免使用前面没有工作表名称的 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$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
        SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:=Sheet1.Range("D41").Offset(lCount2, 0).Address
        SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        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

【讨论】：

谢谢！那效果很好。尽管我需要删除所有“Sheet1”。引用以使单元格填充。不知道为什么会这样。非常感谢。
我发现 Solver 忽略了 SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1" 这行有什么想法吗？
尝试通过用户界面进行操作。这通常是单元格中的错误或单元格中没有公式。您应该创建一个新问题 - 更多了解 Solver 的人会看到它。
谢谢。我确实通过界面尝试过。我会试着玩弄它。如果我运气不好，我会提出一个新问题，但我想你可能想先知道。再次感谢。
不确定是否对评论中的问题提出了另一个问题，但我发现 Solver 将忽略从 VBA 添加时的整数约束。在将它们传递给 SolverAdd 之前，我通过向所有约束添加一个 epsilon 值来绕过它。很高兴知道为什么会发生这种情况以及如何正确解决它。

【解决方案2】：

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

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

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

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

但不是：

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

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

【讨论】：

仍然得到对象'_global'的方法'范围'失败错误。我已按要求使用代码更新了问题。