嵌入了求解器的VBA仅适用于第一个活动单元格引用

时间:2015-06-18 06:08:22

标签: excel vba excel-vba solver

我想创建一个宏,使我能够选择一个活动单元格(“Q50”),它将通过更改$M$2,$M$3,$M$5,$M$7$M$2>=0 and $M$3>=0影响的单元格来最小化活动单元格中的值来生成求解器。代码的每一件事都适用于第一个选定的activecell。但是,当我单击行("Q51")下的后续单元格时,代码不再适用于求解器。请帮助。我是VBA的初学者。请参阅下面的代码。

  Sub JCCMacro()
' JCCMacro Macro

'Save ActiveCell Reference for future use
Dim PrevCell As Range
Set PrevCell = ActiveCell

'Solver Code
    SolverOk SetCell:="PrevCell.Select", MaxMinVal:=2, ValueOf:="0", ByChange:= _
        "$M$2,$M$3,$M$5,$M$7"
   SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1
    'Copy in sample and out of sample error
    PrevCell.Resize(1, 3).Copy

    'Paste Values of in sample and out of sample errors
    PrevCell.Offset(0, 4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'Copy Co-efficient
    Range("M2:M7").Select
    Application.CutCopyMode = False
    Selection.Copy

    'Select paste destination
    PrevCell.Offset(0, 7).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

    'Copy Paste Following months data
    PrevCell.Offset(1, -1).Resize(12, 1).Copy

    'Select target destination
    PrevCell.Offset(0, 13).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
PrevCell.Offset(1, 0).Select
End Sub

1 个答案:

答案 0 :(得分:1)

我想你想要这样的东西:

Sub JCCMacro()
' JCCMacro Macro

'Save ActiveCell Reference for future use
Dim targetCell As Range

    Set targetCell = ActiveCell

'Solver Code
    SolverOk SetCell:=targetCell.Address, MaxMinVal:=2, ValueOf:=0, ByChange:= _
        "$M$2,$M$3,$M$5,$M$7", Engine:=1, EngineDesc:="GRG Nonlinear"
   ' Your code didn't show anything that set these constraints
    SolverAdd CellRef:="$M$3", Relation:=3, FormulaText:="0"""
    SolverAdd CellRef:="$M$2", Relation:=3, FormulaText:="0"""

    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1
    'Copy in sample and out of sample error
    targetCell.Resize(RowSize:=1, ColumnSize:=3).Copy

    'Paste Values of in sample and out of sample errors
    targetCell.Offset(RowOffset:=0, ColumnOffset:=4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'Copy Co-efficient
    targetCell.Parent.Range("M2:M7").Copy

    'Select paste destination
    targetCell.Offset(RowOffset:=0, ColumnOffset:=7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Application.CutCopyMode = False

    'Copy Paste Following months data
    targetCell.Offset(RowOffset:=1, ColumnOffset:=-1).Resize(RowSize:=12, ColumnSize:=1).Copy

    'Select target destination
    targetCell.Offset(RowOffset:=0, ColumnOffset:=13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

    targetCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
End Sub

如果希望求解器使用不同的变量或约束单元格,则需要更改代码中显示的单元格地址。或者定义一个Range变量,然后使用Offset方法更改为指向新单元格,并在解算器代码中使用rangeVariable.Address代替$m$2。< / p>