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

which generates the column of target values (from strt to fnsh using increment) for Solver to take and use instead of (I think!!!) the part that says FormulaText:="$D$41". However I run into various errors and complaints (method 'Range' of Object'_Global'failed- which highlights the line "Range(E41+Count").Select. The complete code I have is:

`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 just need it to update which cell it is optimising to (and putting it in the constraint of solver), then updating which cells to copy and where to paste them. Any help would be greatly appreciated.

4

2 回答 2

2 
Range("E41+Count").Select

This is improper syntax. The following is preferred:

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

or you could use

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

In general, avoid using Range without the sheet name in front of it. Also, only Select when you need to, and that's almost never. Here's an example that doesn't use any Select methods.

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

Lets take into consideration part of the first line from your base solver code. There is:

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

Wherever you have any address in Solver parameters you should pass there address instead of value (which could be quite intuitive but its not working). Therefore you would do something like this:

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

but not:

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

Than you need to improve your loop in that direction. If it doesn't help you please provide complete code of what you have.

于 2013-03-19T12:03:48.300 回答