Question

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

    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"的部分。然而，我遇到了各种错误和抱怨（方法'范围'对象'_Global'失败 - 突出显示行“范围（E41 +计数”）。选择。我的完整代码是：

`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`

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

Answer 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

Answer 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

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

循环与解算器VBA

2 个答案: