Question

（对不起，如果这篇文章出现了两倍）

我在Solver宏下面有一个特定的行（T列中的变量，E和F中的条件，所有相同的行）。我想将宏应用于下面5行（或更多行）并包括T5。

另外，我希望在每个完成的Solver之间保存工作簿，因为解决方法很乏味，我担心我的PC会在解决更大范围的某个时刻崩溃。

任何帮助都非常赞赏！

Sub Solver1()
'
' Solver1 Macro
'

'
    SolverOk MaxMinVal:=0, ValueOf:=0, ByChange:="$T$5", Engine:=3, EngineDesc:= _
        "Evolutionary"
    SolverAdd CellRef:="$F$5", Relation:=2, FormulaText:="$E$5"
    SolverOk MaxMinVal:=0, ValueOf:=0, ByChange:="$T$5", Engine:=3, EngineDesc:= _
        "Evolutionary"
    SolverAdd CellRef:="$T$5", Relation:=3, FormulaText:="0"
    SolverOk MaxMinVal:=0, ValueOf:=0, ByChange:="$T$5", Engine:=3, EngineDesc:= _
        "Evolutionary"
    SolverAdd CellRef:="$T$5", Relation:=1, FormulaText:="90"
    SolverOk MaxMinVal:=0, ValueOf:=0, ByChange:="$T$5", Engine:=3, EngineDesc:= _
        "Evolutionary"
    SolverOptions MaxTime:=0, Iterations:=0, Precision:=0.000000001, Convergence:= _
        0.0000001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
    SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.000075, _
        Multistart:=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
        IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
    SolverOk MaxMinVal:=0, ValueOf:=0, ByChange:="$T$5", Engine:=3, EngineDesc:= _
        "Evolutionary"
    SolverOk MaxMinVal:=0, ValueOf:=0, ByChange:="$T$5", Engine:=3, EngineDesc:= _
        "Evolutionary"
    SolverSolve
End Sub

Answer 1

在提供循环解决方案之前，您发布的内容存在一些（潜在）问题需要更正。

您在调用SolverOK时未指定SetCell。 MS documentation表示SetCell是可选的，但Solver需要“某事”作为目标。如果您已在手动对话框中指定了“设置目标”，则代码可能有效。或者它可能不会，取决于无数可能的事件。您发布的工作表不公开，因此我们无法知道您的目标单元格是什么。
您已指定MaxMinVal:=0。这是一个无效的规范。 MS documentation表示1 =最大化，2 =最小化，3 =匹配特定值。我假设你的意思是MaxMinVal"=1来最大化目标。
您已指定ValueOf:=0。仅在指定MaxMinVal:=3时才需要此规范（例如，匹配特定值）。由于我假设您打算最大化目标，因此不需要ValueOf规范。
您已指定Engine:=3和EngineDesc:="Evolutionary"。虽然，当您录制宏时，会提供这两个参数，但指定它们都是多余的，并且可能导致规范不一致。如果指定它们不一致，则SolverOK调用将失败而不会生成错误。我只会指定Engine:=3。
您有多次调用SolverOK。这是录制宏时生成的代码的残余。只需要一个SolverOK电话。
您有多个SolverAdd调用约束。这没关系，但你需要做一些事情来通过循环活动来管理这些。如果不删除约束，它们将累积。如果您只需要进行几次SolverSolve调用，这也不错，但如果您有许多要调用的话，可能会导致问题。

在下面的代码中，除了解决上述问题外，我还做了以下内容......

使用SolverReset清除所有求解器规格。我通常主张避免使用SolverReset，因为它与SolverSolve交互，在SolverSolve之前调用时，将Excel的计算模式保留为手动。但是，如果在SolverSolve之后调用SolverReset，则会得到相同的重置操作，但计算模式不会“搞乱”。
使用ActiveWorkbook.Save在每次解决后保存工作簿。确保工作簿已保存为启用宏的工作簿。
使用注释中建议的方法Dirk来构建Solver所需的地址字符串。还有其他方法，但这种方法在这种情况下效果很好。尽管MS文档显示Ranges可以提供给Solver例程，但这并不总是有效。

要使用以下代码，您需要：

更改SetCell:="$U$" & iLoop以表示工作簿中的目标单元格。
确认您希望最大化目标。否则，将MaxMinVal:=1更改为适当的值。如果您设置MaxMinVal:=3，则需要重新插入ValueOf。

代码......

Sub Solver2()
'
Dim iLoop As Long
    For iLoop = 5 To 9
        SolverOk SetCell:="$U$" & iLoop, MaxMinVal:=1, ByChange:="$T$" & iLoop, Engine:=3
        SolverAdd CellRef:="$F$" & iLoop, Relation:=2, FormulaText:="$E$" & iLoop
        SolverAdd CellRef:="$T$" & iLoop, Relation:=3, FormulaText:="0"
        SolverAdd CellRef:="$T$" & iLoop, Relation:=1, FormulaText:="90"
        SolverOptions MaxTime:=0, Iterations:=0, Precision:=0.000000001, Convergence:= _
            0.0000001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
        SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.000075, _
            Multistart:=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
            IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
        SolverSolve UserFinish:=True
        SolverReset
        ActiveWorkbook.Save
    Next iLoop
End Sub

修改 - 基于检查工作表布局

工作表的布局方式，您的目标单元格位于列F中，目标的目标位于列E中。列U只是一个布尔计算，用于确定答案是否“足够接近”。下面的代码是在Solver中表示此代码的更好方法。 另外，我会考虑使用GRG Nonlinear

Dim iLoop As Long
    For iLoop = 4 To 9
        SolverOk SetCell:="$F$" & iLoop, MaxMinVal:=3, ValueOf:="$E$" & iLoop, ByChange:="$T$" & iLoop, Engine:=3
        SolverAdd CellRef:="$T$" & iLoop, Relation:=3, FormulaText:="0"
        SolverAdd CellRef:="$T$" & iLoop, Relation:=1, FormulaText:="90"
        SolverOptions MaxTime:=0, Iterations:=0, Precision:=0.0000001, Convergence:= _
            0.00001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
        SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.0075, _
            Multistart:=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
            IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
        SolverSolve UserFinish:=True
        SolverReset
        ActiveWorkbook.Save
    Next iLoop
End Sub

Answer 2

对不起，迟到的回答，但我很忙:(

我也无法简化您的计算，但是，这个宏可能更符合您的要求（没有求解器，仍然使用工作表）

Sub No_Solver_Solve()
  Dim valR As Double, valO As Double, valT As Double, oBool As Boolean, i As Long, holder As String

  Dim UVal As Long, LVal As Long, SVal As Double, Trow As Long, BRow As Long, MaxDiff As Double

  UVal = 150      'upper limit
  LVal = 0        'lower limit
  SVal = 10       'initial stepping
  MaxDiff = 0.001 'max difference from target value

  Trow = 5 'top row
  BRow = 25 'bottom row

  Application.Calculation = xlCalculationManual

  For i = Trow To BRow
    valR = SVal
    Range("T" & i) = UVal
    holder = Range("D" & i).Formula
    Range("D" & i).Value = 0
    Calculate
    Range("D" & i).Formula = holder
    Calculate

      'get first non-error value
    While IsError(Range("U" & i)) And Range("T" & i) >= LVal
      Range("T" & i) = Range("T" & i) - SVal
      Rows(i).Calculate
      Rows(i).Calculate
    Wend

      'if only errors are found
    If Range("T" & i) < LVal Then
      MsgBox "No valid value found for row " & i & "!"
      Application.Calculation = xlCalculationAutomatic
      Exit Sub
    End If

      'jump over peak
    valO = (Range("E" & i) - Range("F" & i))
    oBool = (valO >= 0)
    valT = Range("T" & i)
    If valT = LVal Then valR = -valR

    While (oBool And ((Range("E" & i) - Range("F" & i)) > 0)) Or (Not oBool And ((Range("E" & i) - Range("F" & i)) < 0))

      Range("T" & i) = Range("T" & i) - valR
      Rows(i).Calculate

        'if step ends in error (smaller step)
      If IsError(Range("F" & i)) Then
        Range("T" & i) = Range("T" & i) + valR
        valR = valR / 2
        Rows(i).Calculate

        'peak outside of range
      ElseIf (valT = LVal Or valT = UVal) And (oBool And (valO < (Range("E" & i) - Range("F" & i)))) Or (Not oBool And (valO > (Range("E" & i) - Range("F" & i)))) Then
        MsgBox "Peak out of range for row " & i & "!"
        Application.Calculation = xlCalculationAutomatic
        Exit Sub

        'deactivate for later runs
      Else
        If valT = LVal Or valT = UVal Then
          If LVal <> 0 And UVal <> 0 Then
            valT = 0
          ElseIf LVal <> 1 And UVal <> 1 Then
            valT = 1
          Else
            valT = 2
          End If
        End If
      End If

    Wend

       'run for peak
    While Abs(Range("E" & i) - Range("F" & i)) > MaxDiff
      valR = valR / 2
      oBool = ((Range("E" & i) - Range("F" & i)) > 0)
      Range("T" & i) = Range("T" & i) + valR
      Rows(i).Calculate
      Rows(i).Calculate
      If oBool = ((Range("E" & i) - Range("F" & i)) < 0) Then valR = -valR
    Wend
  Next

  Application.Calculation = xlCalculationAutomatic

End Sub

对我来说，第5行到第9行需要大约1.5秒（第10行是105，超出范围）。请逐行运行代码以了解发生了什么以及它是如何工作的，如果不清楚，请问。 ;）

然而，有时会有一些“跳跃”。这意味着每次重新计算时值都会发生变化。这样一个可行的解决方案可能会在一些迭代后超过你的“回合”，之后会出错。出于这个原因，我从F列中的公式中删除了ROUND。（对于所有行，仍然需要大约1.5秒。）

这也应该可以消除你的错误（据我所知，没有限制去积极）。另一方面，如果步长很大并且峰值非常接近最大值/最小值，则可能会失败。（这样你应该增加一点以确保）

多行的VBA（Excel）解算器+文件保存

2 个答案: