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

Question

我想创建一个宏，使我能够 select 一个活动单元格 ("Q50")，它将通过更改单元格 $M,$M,$M,$M 来最小化活动单元格中的值来生成求解器$M>=0 and $M>=0。对于第一个 selected 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,$M,$M,$M"
   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

Answer 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,$M,$M,$M", Engine:=1, EngineDesc:="GRG Nonlinear"
   ' Your code didn't show anything that set these constraints
    SolverAdd CellRef:="$M", Relation:=3, FormulaText:="0"""
    SolverAdd CellRef:="$M", 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.

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

VBA with solver embedded only works for first active cell reference

excel

vba

solver