具有規划求解的Excel中的VBA循環

Question

所以這是我的問題。 我正在嘗試編寫一個使用求解器執行功能的循環。 基本上，它從一個單元格開始，運行求解器，將目標單元格和約束單元格移至右側，求解，將目標單元格和約束單元格移至右側14個，求解，右側一個，求解，右側14個求解，直到找到一個空白。

這是前幾行代碼，向您展示我在長版中的工作。

Range("RI6").Select
    SolverOk SetCell:="$RI$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$RG$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$RI$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$RI$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("RJ16").Select
    SolverOk SetCell:="$RJ$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$RJ$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$RJ$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$RJ$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("RX16").Select
    SolverOk SetCell:="$RX$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$RX$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$RX$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$RX$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("RY16").Select
    SolverOk SetCell:="$RY$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$RY$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$RY$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$RY$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("SM16").Select
    SolverOk SetCell:="$SM$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$SM$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$SM$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$SM$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("SN16").Select
    SolverOk SetCell:="$SN$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$SN$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$SN$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$SN$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("TB16").Select
    SolverOk SetCell:="$TB$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$TB$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$TB$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$TB$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("TC16").Select
    SolverOk SetCell:="$TC$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$TC$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$TC$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$TC$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("TQ16").Select
    SolverOk SetCell:="$TQ$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$TQ$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$TQ$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$TQ$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("TR16").Select
    SolverOk SetCell:="$TR$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$TR$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$TR$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$TR$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("UF16").Select
    SolverOk SetCell:="$UF$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$UF$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$UF$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$UF$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)
Range("UG16").Select
    SolverOk SetCell:="$UG$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$UG$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$UG$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$UG$1", Relation:=1, FormulaText:="87"
    SolverSolve (True) 

預先感謝您的任何幫助/建議。

Answer 1

未經測試，但也許像...

Option Explicit

Sub SolverLop()
Dim i As Long
Dim cnt As Integer
cnt = 0
For i = 477 To ActiveSheet.UsedRange.Columns.Count

    SolverReset
    SolverOk SetCell:=Cells(16, i).Address, MaxMinVal:=3, ValueOf:=0.15, ByChange:=Cells(16, i).Address, _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:=Cells(1, i).Address, Relation:=3, FormulaText:="74"
    SolverAdd CellRef:=Cells(1, i).Address, Relation:=1, FormulaText:="87"
    SolverSolve Userfinish:=True

    cnt = cnt + 1
    If cnt = 2 Then
        i = i + 14
        cnt = 0
    End If
Next

End Sub

確保在工具->引用->解算器中選中對求解器的引用。

在上面的示例中，PS 477是與起始列“ RJ”關聯的列號...要獲取任何列的列號，只需在空白單元格=column(indirect("A2"))鍵入以下內容即可。 ..用要查找其編號的列替換“ A2”。

Answer 2

第一部分看起來與其他部分不同，因此我沒有將其包括在“循環”中，但是如果差異是由於錯字引起的，那么添加起來就很容易了。

    Range("RI6").Select
    SolverOk SetCell:="$RI$16", MaxMinVal:=3, ValueOf:=0.15, ByChange:="$RG$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$RI$1", Relation:=3, FormulaText:="74"
    SolverAdd CellRef:="$RI$1", Relation:=1, FormulaText:="87"
    SolverSolve (True)

因此，一種循環方式如下：

    Dim Temp As String, TempArray As Variant

    TempArray = Array("RJ16", "RX16", "RY16", "SM16", "SN16", "TB16", "TC16", "TQ16", "TR16", "UF16", "UG16")
    For i = 0 To UBound(TempArray)
        Range(TempArray(i)).select
        Temp = Cells(1, Range(TempArray(i)).Column).Address
        SolverOk SetCell:=TempArray(i), MaxMinVal:=3, ValueOf:=0.15, ByChange:=Temp, Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverAdd CellRef:=Temp, Relation:=3, FormulaText:="74"
        SolverAdd CellRef:=Temp, Relation:=1, FormulaText:="87"
        SolverSolve (True)
    Next i