Loop With Solver VBA

Question

Привет, У меня есть следующий код, который запускает одну оптимизацию с помощью решателя, который я хотел бы запускать в цикле. единый код пробег:

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 

, который генерирует столбец целевых значений (от STRT к fnsh используя приращение) для Solver, чтобы взять и использовать вместо (я думаю !!!) часть, которая говорит FormulaText:="$D$41". .. Однако я бег в различные ошибки и жалобы (метод 'Range' в Object'_Global'failed- подчеркивающей линии "Range (E41 + Count") Выберите Полный код у меня есть:

`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` 

I просто нужно, чтобы он обновил, какую ячейку он оптимизирует (и помещает его в ограничение решателя), а затем обновляет, какие ячейки копировать и куда их вставлять. Любая помощь будет принята с благодарностью.

Answer 1

Range("E41+Count").Select 

Это неправильный синтаксис. Следующее является предпочтительным:

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

или вы могли бы использовать

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

В общем, избегать использования диапазона без имени листа перед ним. Также, только выберите, когда вам нужно, и это почти никогда. Вот пример, который не использует методы 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 

Answer 2

Давайте принять во внимание часть из первой строки из вашего кода базового решателя. Существует:

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

Везде, где у вас есть адрес в параметрах Solver, вы должны передать туда адрес вместо значения (который может быть довольно интуитивным, но не работать). Поэтому вы могли бы сделать что-то вроде этого:

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

но не:

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

Чем вам нужно улучшить свой цикл в этом направлении. Если это не поможет вам предоставить полный код того, что у вас есть.