简体   繁体   中英

VBA with solver embedded only works for first active cell reference

I would like to create a macro to enable me to select an active cell("Q50") which will generate solver by minimising value in activecell by changing cells $M$2,$M$3,$M$5,$M$7 subject to $M$2>=0 and $M$3>=0 . Every thing with the code works fine for the first selected activecell. However when I click the subsequent cell down the row ("Q51") , the code doesn't work for the solver anymore. Kindly help. I am a beginner in VBA. See below for code.

  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

I think you want something like this:

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

If you want solver to use different variable or constraint cells, you will need to change the cell addresses shown in the code. Or define a Range variable which you then change to point to the new cells, using the Offset method maybe, and in the solver code use rangeVariable.Address instead of $m$2 .

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM