Question

我有一个sub使用Solver函数运行Solver 50次。但是，我试图在每次运行后复制并粘贴Solver结果。例如，在“优化”选项卡上，单元格范围E1：O13显示解算器结果，但每次运行结果都将覆盖在同一部分上。我想将单元格范围E1：E13复制到从单元格A1开始的另一个工作表调用“SolverResults”，比如第一次运行Solver的范围单元格A1：K13，然后将第二轮Solver复制并粘贴到单元格A16中： K28，等等。对于复制和粘贴部分，我不知道如何使用循环，因此目前在SolverResults选项卡上，我只显示A1：K13上的一段数据，这是Solver完成运行50次并且F1 = 221。

任何人都知道如何使用循环逐节复制和粘贴结果？我对VBA很新，所以任何建议都表示赞赏！

    {Sub RRS()
For i = 0 To 50 Step 1
SolverReset
Range("F1") = 271 - i
    SolverOk SetCell:="$L$13", MaxMinVal:=3, ValueOf:=0.01, ByChange:="$F$4:$F$12" _
        , Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverOptions MaxTime:=0, Iterations:=0, Precision:=0.001, Convergence:=0.0001 _
        , StepThru:=False, Scaling:=False, AssumeNonNeg:=True, Derivatives:=2
    SolverAdd CellRef:="$F$4:$F$12", Relation:=1, FormulaText:="$I$4:$I$12"
    SolverAdd CellRef:="$F$4:$F$12", Relation:=3, FormulaText:="$H$4:$H$12"
    SolverAdd CellRef:="$F$13", Relation:=2, FormulaText:="1"
    SolverSolve (True)
    SolverFinish KeepFinal:=1
    Worksheets("Optimization").Range("E1:O13").Copy Destination:=Worksheets("SolverResults").Range("A1")
Next i
End Sub
}

Answer 1

替换此行：

Worksheets("Optimization").Range("E1:O13").Copy Destination:=Worksheets("SolverResults").Range("A1")

有了这个

If i = 0 Then

    Worksheets("SolverResults").Range("A1").Resize(13,11).Value = _ 
        Worksheets("Optimization").Range("E1:O13").Value

Else

   Worksheets("SolverResults").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(13,11).Value = _ 
        Worksheets("Optimization").Range("E1:O13").Value

End If

每次运行后复制并粘贴解算器结果

1 个答案: