Question

我是VBA和Solver的新人。我为Excel制作了这个宏：

Sub Macro4()
'
' Macro4 Macro
' Mas4
'
'
SolverOk SetCell:="$CU$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BI$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$CU$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BI$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="$CV$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BJ$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$CV$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BJ$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="$CW$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BK$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$CW$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BK$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="$CX$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BL$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$CX$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BL$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="$CY$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BM$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$CY$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BM$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="$CZ$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BN$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$CZ$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BN$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="$DA$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BO$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:="$DA$134", MaxMinVal:=3, ValueOf:=1, ByChange:="$BO$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True

Range("BI3:BO3").Select
Selection.Copy

Range("DI134").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

它工作正常，但仅适用于行134.当条件Q134>如果满足125则必须执行宏。我需要搜索满足条件Q（行数）的其他Q行＆gt;然后，应该执行宏，然后改变行134以获得满足条件的“行数”。我不知道如何将这个“numbre of row”传递给Macro的引用。

正如您将看到的，每次执行宏时我都需要保存Solver输出，但我不知道该怎么做。这就是我使用的原因：

Range("DI134").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

在我的宏的最后一部分。

提前致谢，对不起我的经验感到抱歉。

Answer 1

以下是一个可以做你感兴趣的例行程序......

Sub SolveRow(myRow As Long)
Dim iLoop As Long
Dim SetRng As Range, ChngRng As Range
Dim mySht As Worksheet
Dim SetAddress As String, ChngAddress As String
'
'
    Set mySht = Worksheets("Sheet4")
    For iLoop = 1 To 7
        Set SetRng = mySht.Range(mySht.Cells(myRow, iLoop + 98), mySht.Cells(myRow, iLoop + 98))
        SetAddress = Split(SetRng.Address(external:=True), "[")(0) & Split(SetRng.Address(external:=True), "]")(1)
        Set ChngRng = mySht.Range(mySht.Cells(3, iLoop + 60), mySht.Cells(3, iLoop + 60))
        ChngAddress = Split(ChngRng.Address(external:=True), "[")(0) & Split(ChngRng.Address(external:=True), "]")(1)

        SolverOk SetCell:=SetAddress, MaxMinVal:=3, ValueOf:=1, ByChange:=ChngAddress, Engine:=1
        SolverSolve UserFinish:=True
    Next iLoop

    mySht.Range("BI3:BO3").Copy
    mySht.Range("DI" & myRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set mySht = Nothing
End Sub

这可以由另一个确定需要计算哪一行的VBA例程调用。例如...

Sub main()
Dim theRow As Long
    theRow = 134
    SolveRow (theRow)
End Sub

让我们分解SolveRow子。在线...

Set mySht = Worksheets("Sheet4")

...您应该将“Sheet4”更改为包含公式的工作表的名称。

循环......

For iLoop = 1 To 7
   ...
Next iLoop

...做了7次迭代。你原始代码中的数字。

确定SetCell值的行是......

    Set SetRng = mySht.Range(mySht.Cells(myRow, iLoop + 98), mySht.Cells(myRow, iLoop + 98))
    SetAddress = Split(SetRng.Address(external:=True), "[")(0) & Split(SetRng.Address(external:=True), "]")(1)

...第一行定义范围。 'iLoop + 98'从99变为105，这对应于列CU到DA。第二行评估为具有完全限定范围的字符串 - 它将类似于Sheet4!$CU$134。

确定ByChange值的行是......

    Set ChngRng = mySht.Range(mySht.Cells(3, iLoop + 60), mySht.Cells(3, iLoop + 60))
    ChngAddress = Split(ChngRng.Address(external:=True), "[")(0) & Split(ChngRng.Address(external:=True), "]")(1)

...您似乎总是更改第3行中的值，因此它是硬编码的。 iLoop + 60将对应于BI到BO列。

注意：

不调用SolverReset。这会导致设置手动计算模式时出现问题。
在SolverOK中，仅指定Engine:=1。如果同时指定Engine:=1, EngineDesc:="GRG Nonlinear"，则会出现意外行为。（问题没有重新定义，第一个问题将得到解决7次）。

两条线，几乎就是你所拥有的......

mySht.Range("BI3:BO3").Copy
mySht.Range("DI" & myRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

...执行复制/粘贴操作。同样，我假设您总是希望复制第三行，因此范围是硬编码的。如果不是这样，上面使用的技术可用于指定正确的范围。我还假设你想要粘贴你在Solver calc中所做的同一行。

Answer 2

我认为我已经找到了如何传递细胞数作为参考。例如SolverOk SetCell：=＆＃34; CU＆＃34; ＆安培;我

现在我的宏就像这样，它可以正常工作：

Sub Macro7()

Dim i As Long
Dim k As Long
k = 0
Dim s As Long
s = 1

For i = 8 To 77806
k = k + 1

If Range("Q" & i) > 125 Then
s = i - k + 1
k = 0

SolverOk SetCell:="CU" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BI$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="CV" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BJ$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="CW" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BK$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="CX" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BL$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="CY" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BM$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="CZ" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BN$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True
SolverOk SetCell:="DA" & i, MaxMinVal:=3, ValueOf:=1, ByChange:="$BO$3", _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve UserFinish:=True

Range("BI3:BO3").Select
Selection.Copy
Range("DI" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("CU" & i & ":DA" & i).Select
Selection.Copy
Range("DB" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Range("BP" & s & ":BV" & i).Select
Selection.Copy
Range("DP" & s).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End If

Next i

End Sub

如你所见，我已经添加了我需要的其他东西。

非常感谢大家。好论坛。

VBA中的求解器具有循环和条件

2 个答案: