0

こんにちは、ループで実行したいソルバーを介して単一の最適化を実行する次のコードがあります。シングルランコードは次のとおりです。

    Sub Macro4
SolverReset
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41").Select
    ActiveSheet.Paste
    Range("D36").Select

Application.CutCopyMode = False
Selection.Copy
Range("F41").Select
ActiveSheet.Paste
Range("D36").Select


Range("D7:R7").Select
Application.CutCopyMode = False


   Selection.Copy
    Range("I41").Select
    ActiveSheet.Paste
End Sub

ソルバーは $D$41 の値に (他の制約の中で) 最適化し、いくつかの個々のセルと配列をコピーしてソリューションを貼り付け、元のターゲット セルと一緒に (つまり、行 41 に) 貼り付けます。これはうまく機能します。ただし、ループ（またはより良い代替手段）を使用して、列内の各セルを順番に最適化してから、ソリューションを横に貼り付けることで、ターゲットセルの列に対して実行しようとしています。シングルランコード。たとえば、次のコードとマージしようとしています

    Sub Complete()
'
'
'
Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

    For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count
    Next Count
End Sub

これは、Solver がFormulaText:="$D$41". ただし、さまざまなエラーや苦情が発生します (Object'_Global' のメソッド 'Range'failed-「Range(E41+Count」) の行が強調表示されます)。Select。私が持っている完全なコードは次のとおりです。

`Sub Macro5()
   Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count

    SolverReset
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41:$D$41+Count"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41+Count").Select
    ActiveSheet.Paste
    Range("D36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F41+Count").Select
    ActiveSheet.Paste

    Range("D7:R7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("I41+Count").Select
    ActiveSheet.Paste

Next Count 
End Sub`

最適化するセルを更新し（そしてソルバーの制約に入れ）、コピーするセルと貼り付ける場所を更新するだけです。どんな助けでも大歓迎です。

4

2 に答える 2

2 
Range("E41+Count").Select

これは不適切な構文です。以下が推奨されます。

Range("E41").Offset(Count,0).Select

またはあなたが使用することができます

Range("E" & 41 + Count).Select

一般に、シート名を前に付けずに Range を使用することは避けてください。また、必要なときにのみ選択します。それはほとんどありません。Select メソッドを使用しない例を次に示します。

Sub Complete()

    Dim lStrt As Long, lFnsh As Long
    Dim lCount As Long, lCount2 As Long
    Dim lIncrement As Long

    For lCount = lStrt To lFnsh Step lIncrement
        lCount2 = lCount / lIncrement

        Sheet1.Range("D41").Offset(lCount2, 0).Value = lCount

        SolverReset
        SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
        SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:=Sheet1.Range("D41").Offset(lCount2, 0).Address
        SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        SolverSolve UserFinish:=True
        SolverFinish KeepFinal:=1

        Sheet1.Range("E41").Offset(lCount2, 0).Value = Sheet1.Range("D37").Value
        Sheet1.Range("F41").Offset(lCount2, 0).Value = Sheet1.Range("D36").Value
        Sheet1.Range("D7:R7").Copy Sheet1.Range("I41").Offset(lCount2, 0)

    Next lCount

End Sub
于 2013-03-19T15:04:31.407 に答える
1

ベース ソルバー コードの最初の行の一部を考慮してみましょう。がある：

SolverOk SetCell:="$D$36" 'and so on...

ソルバー パラメータにアドレスがある場合は、値の代わりにアドレスを渡す必要があります (これは非常に直感的ですが、機能しません)。したがって、次のようにします。

SolverOk SetCell:=Range("$D$36").Address '... structure ok

だがしかし：

SolverOk SetCell:=Range("$D$36").Value   '... wrong structure

その方向にループを改善する必要があるよりも。役に立たない場合は、持っているものの完全なコードを提供してください。

于 2013-03-19T12:03:48.300 に答える