【问题标题】:VBA Macro optimization using Solver in Excel not returning optimal variables在 Excel 中使用 Solver 进行 VBA 宏优化不返回最佳变量
【发布时间】:2015-09-28 18:05:35
【问题描述】:

我正在尝试优化 Excel 中的三个参数,以尽量减少实验值和理论值之间的误差。我在 for 循环中对每个参数使用 Solver,一次一个。但是,我想迭代这个求解器for循环(循环内循环),直到实验值和理论值的误差小于某个目标值。

我的实验值为$K25.
我的理论值(根据我的模型方程计算)是$J$25
我需要优化的参数是$C$4,$C$5,$C$6

当我运行以下 VBA 代码时,$C$4$C$5$C$6 中的参数不会从它们的初始值改变。但是,宏编译得很好,没有错误。有谁能帮帮我吗?

代码如下:

Sub Macro3()
    Application.ScreenUpdating = False
    SolverReset
    Dim j As Integer
    For j = 1 To 100 Step 1
        If "$J$25" > "$K$25" Then
            Dim i As Integer, s As String
            For i = 4 To 6 Step 1
            s = Format(i, "0")
                SolverOk SetCell:="$J$25", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$" & s, Engine:= _
                1, EngineDesc:="GRG Nonlinear"
                SolverOptions MaxTime:=0, Iterations:=1000000, Precision:=0.000001, Convergence _
                :=0.00001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
                SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.075, Multistart _
                :=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
                IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
                SolverOk SetCell:="$J$25", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$" & s, Engine:= _
                1, EngineDesc:="GRG Nonlinear"
                SolverSolve (True)
                SolverReset
            Next i
        End If
    Next j
    Application.ScreenUpdating = True
End Sub

【问题讨论】:

    标签: vba excel solver


    【解决方案1】:

    我不确定您是否需要在 VBA 中执行此操作,因为您正在寻找的正是 Solver 应该做的 - 修改一组参数,以便最大化/最小化其他东西!

    因此,您只需在另一个单元格中插入公式=ABS(J25-K25)。该单元格将显示您的实验值和理论值之间的差值。现在设置您的求解器,以便通过更改您的三个参数来最小化这个单元格——您就完成了! (请注意,您可以在“通过更改可变单元格”字段中提供多个单元格!)

    如果您想坚持自己的方法,这里是语法正确的代码。请注意,我尚未对其进行测试 - 但仅纠正了通过查看代码可以发现的错误。希望这将是一个很好的起点。事实上,看看这种方法,我相信你最终会得到错误的结果,因为每次运行只优化一个变量 - 因此你永远不会研究由两个或三个参数组合产生的任何影响!

    无论如何,这是你的代码:

    Sub RunSolver()
        Dim j As Integer, i As Integer
    
        Application.ScreenUpdating = False
        SolverReset
    
        For j = 1 To 100
            Application.Statusbar = j & "/100"
            If Range("$J$25") > Range("$K$25") Then
                For i = 4 To 6
                    SolverOk SetCell:=Range("$J$25"), MaxMinVal:=2, ValueOf:=0, ByChange:=Range("$C$" & i), Engine:= _
                    1, EngineDesc:="GRG Nonlinear"
                    SolverOptions MaxTime:=0, Iterations:=1000000, Precision:=0.000001, Convergence _
                    :=0.00001, StepThru:=False, Scaling:=True, AssumeNonNeg:=True, Derivatives:=1
                    SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.075, Multistart _
                    :=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
                    IntTolerance:=1, SolveWithout:=False, MaxTimeNoImp:=30
                    SolverSolve (True)
                    SolverReset
                Next i
            End If
        Next j
    
        Application.StatusBar = False
        Application.ScreenUpdating = True
    End Sub
    

    【讨论】:

    • 谢谢!你的建议是正确的。我正在计算我的理论方程与我的实验结果的总差异的绝对值。然后我优化我的参数以最小化这种差异。 $K$25 是我的目标差异,$J$25 是我当前的差异,基于 $C$4、$C$5、$C$6 中的参数。所以是的,正如你所建议的,我可以简单地让求解器一次优化所有三个参数,我就完成了。但是,我最终想要优化 10 个参数,而不是三个更复杂的方程。而且多个参数的组合会很棘手!
    • 相当肯定 Solver 也可以处理 10 个参数并获得更好的结果,然后在其他条件不变的情况下错误地优化每个参数的宏!
    • 您建议的代码有效。我刚刚测试了它。但是,如果 $K$25(目标差值)设置为低于 Solver 收敛的值,Excel 会继续计算并且不会得到任何结果。不确定您是否知道防止这种情况发生的快速方法?
    • 将差异乘以一个大因子会怎样?
    • 是的求解器可以处理十个参数。但当我的方程很复杂并且解决了超过 100K 行时,可能不会。在我更复杂的情况下,我最多可以让求解器一次完成两个或三个参数,最终只有一个参数实际从其初始值发生变化。因此,我认为一次做一个参数是最好的,即使我忽略了一次更改多个参数的影响。我希望遍历每个参数最终会收敛到一个有意义的结果,在生理上是有意义的。再次感谢!
    【解决方案2】:

    您可以仔细检查您的代码行:

    Engine:= 1, EngineDesc:="GRG Nonlinear"
    

    根据MS documentation

    • 1 表示 Simplex LP 方法,
    • 2 表示 GRG 非线性方法,或
    • 3 代表进化方法。

    您的目标函数可能是非线性,并且您认为您正在使用 GRG 非线性求解器,因为您在 EngineDesc 参数下提到了它。这是不正确的。这只是一个描述参数。

    您实际使用的求解器是 Simplex LP,其值为 1

    更改为 2 以使用 GRG 非线性求解器

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2023-01-09
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多