Excel VBA：ループ内でソルバーが機能しない

Question

ループ内のソルバーは、最初の反復では動作しますが、残りは動作しません。残りのループはうまく動作します。

Sub Macro1() 

Sheets("model").Select 
Dim i As Double 
Dim p As Double 


For i = 1 To 10 
p = -0.1565 + ((i - 1) * 0.0015) 
Sheets("model").Range("J15").Value = p 


SolverOk SetCell:="$J$12", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$4:$F$4", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverOk SetCell:="$J$12", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$4:$F$4", _ 
    Engine:=1, EngineDesc:="GRG Nonlinear" 
SolverSolve (True) 



Sheets("rec").Select 
Range("B1:H1").Select 
Selection.Copy 
Sheets("rec").Range(Cells((i + 4), 2), Cells((i + 4), 8)).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("C5").Select 

Next i 

End Sub 

Answer 1

残念ながら、ソルバーはシートのみがアクティブである場合に作動するので、あなたの最初のSolverOk文の前

Worksheets("model").Activate 

を挿入します。

Sub Macro1() 

    Dim i As Long 
    Dim p As Double 

    For i = 1 To 10 
     p = -0.1565 + ((i - 1) * 0.0015) 
     With Worksheets("model") 
      .Activate 
      .Range("J15").Value = p 
      SolverOk SetCell:="$J$12", _ 
        MaxMinVal:=2, _ 
        ValueOf:=0, _ 
        ByChange:="$B$4:$F$4", _ 
        Engine:=1, _ 
        EngineDesc:="GRG Nonlinear" 
      SolverOk SetCell:="$J$12", _ 
        MaxMinVal:=2, _ 
        ValueOf:=0, _ 
        ByChange:="$B$4:$F$4", _ 
        Engine:=1, _ 
        EngineDesc:="GRG Nonlinear" 
      SolverSolve True 
     End With 

     With Worksheets("rec") 
      .Range(.Cells(i + 4, "B"), .Cells(i + 4, "H")).Value = .Range("B1:H1").Value 
     End With 
    Next i 
End Sub