跨多列和多行的求解器 VBA 宏

Question

VBA 的新手。网上搜了一圈，没找到解决办法（不过在这个过程中学到了很多东西）。

我是运行宁求解器来求解一个收入数字，在给定某些费用的情况下，该收入数字将给我指定的利润率。我已经准备好一切，还有一个 Sub 可以正常执行此任务一个月。但是，我正在尝试将其应用于 12 列（12 个月）。然后将循环向下步进 19 行。运行求解器跨越这 12 列等等 6 次。

代码如下：

Sub Monthly()


SolverReset
SolverAdd CellRef:="$d", Relation:=2, FormulaText:="$d"
SolverOk SetCell:="$d", MaxMinVal:=1, ValueOf:=0, ByChange:="$d", Engine _
    :=1, EngineDesc:="GRG Nonlinear"
SolverSolve True

SolverReset
SolverAdd CellRef:="$e", Relation:=2, FormulaText:="$e"
SolverOk SetCell:="$e", MaxMinVal:=1, ValueOf:=0, ByChange:="$e", Engine _
    :=1, EngineDesc:="GRG Nonlinear"
SolverSolve True

这是一个可以让我在一月和二月得到的例子。希望它在剩余的 10 个月内达到运行（无需复制和粘贴这 10 次并手动输入 F-O 列的单元格坐标）。然后下面的代码是向下19行的代码：

SolverReset
SolverAdd CellRef:="$d", Relation:=2, FormulaText:="$d"
SolverOk SetCell:="$d", MaxMinVal:=1, ValueOf:=0, ByChange:="$d", Engine _
    :=1, EngineDesc:="GRG Nonlinear"
SolverSolve True


End Sub

再一次，我希望运行跨 12 列并向下移动 19 行，再重复 4 次。所以最终结果是 solver 运行ning 在 12 列中求解 6 次，总共求解 72 次。我宁愿不要多次键入这些单元格坐标，而且这样做可能对我的 CPU 造成负担。谢谢！

更新：

我现在收到一个错误，似乎是无缘无故的。这东西很好用。

Sub MonthlySolve1a()
    Dim c As Range
    Set c = ActiveSheet.Range("D40")
    MonthlySolve1b c
End Sub

'solve 12 months
Sub MonthlySolve1b(c As Range)
Dim m  As Long
For m = 1 To 12

    SolverReset
    SolverAdd CellRef:=c.Address(), Relation:=2, FormulaText:=c.Offset(1, 0).Address()
    SolverOk SetCell:=c.Address(), MaxMinVal:=1, ValueOf:=0, _
            ByChange:=c.Offset(-16, 0).Address(), Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverSolve True

    Set c = c.Offset(0, 1)
Next m
End Sub

我可能在我的 sheet 中做了一些愚蠢的事情，把它搞砸了，但是任何见解都将不胜感激。谢谢！

Answer 1

您可以在每个月使用循环运行求解器：

Sub Tester()
    Dim c As Range
    Set c = ActiveSheet.Range("D40")
    Monthly c
End Sub


'solve 12 months
Sub Monthly(c As Range)
    Dim m  As Long
    For m = 1 To 12

        SolverReset
        SolverAdd CellRef:=c.Address(), Relation:=2, FormulaText:=c.Offset(1, 0).Address()
        SolverOk SetCell:=c.Address(), MaxMinVal:=1, ValueOf:=0, _
                ByChange:=c.Offset(-16, 0).Address(), Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverSolve True

        Set c = c.Offset(0, 1)
    Next m
End Sub

跨多列和多行的求解器 VBA 宏

Solver VBA macro across multiple columns and rows

excel

vba

solver