Question

我是VBA的新手并试图实现Excel Solver Loop。到目前为止，我没有为我的具体问题找到解决方案，所以我希望我能在这里得到一些帮助。

所以我正在做的是以下内容：

使用Solver最小化目标单元格（在本例中为B16）
根据需要多次更改单元格值（C2），直到解算器解决方案发生变化（值变大或变小，取决于E8的值，可以是1或0）
在预定义的单元格中复制此单元格值（F8或G8，具体取决于
E8的值，可以是1或0）
将单元格值（C2）更改为开头的起始值
切换到下面的下一个单元格（C3）并更改单元格值直到解决方案更改
在预定义的单元格中复制此单元格值（F9或G9，具体取决于
E9的值，可以是1或0）

因此，直到第4步，它才能完美运行，但仅适用于那个单元格。我希望现在有可能逐个细胞。因此我尝试通过实现一个i来计算行但总是得到默认消息。

所以这里是我的代码：

Sub Makro6()
Dim rng As Range, cell As Range
Set rng = Range("C2")

If Range("E8").Value = 1 Then

Do
    For Each cell In rng
    cell.Value = cell.Value + 1
    Next cell

    SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
    Engine:=2, EngineDesc:="Simplex LP"
    SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
    Engine:=2, EngineDesc:="Simplex LP"
    SolverSolve True

Loop Until Range("E8").Value = 0

   'Copying cell Value, when Solver solution switched in certain cell depending if it before was 1 or 0
   Range("C2").Select
   Selection.Copy
   Range("F8").Select
   ActiveSheet.Paste

   'Copying start value back into cell after solver loop
   Range("B2").Select
   Selection.Copy
   Range("C2").Select
   ActiveSheet.Paste

Else

Do
    For Each cell In rng
    cell.Value = cell.Value - 1
    Next cell

    SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
    Engine:=2, EngineDesc:="Simplex LP"
    SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
    Engine:=2, EngineDesc:="Simplex LP"
    SolverSolve True

Loop Until Range("E8").Value = 1

   'Copying cell Value, when Solver solution switched in certain cell depending if it before was 1 or 0
   Range("C2").Select
   Selection.Copy
   Range("G8").Select
   ActiveSheet.Paste

   'Copying start value back into cell after solver loop
   Range("B2").Select
   Selection.Copy
   Range("C2").Select
   ActiveSheet.Paste

End If

End Sub

非常感谢您的帮助：）

Answer 1

我认为你正在寻找类似的东西。

ActiveCell.Offset(1,0).Select

请记住，它总是（行，列），所以如果你在单元格C3中，上面的代码将移动到C4。如果您在单元格C3中并且想要移动到D3，则可以这样做。

ActiveCell.Offset(0,1).Select

Answer 2

好的，给它一个旋转。它应该适用于C2和C3，但可以通过更改定义rng的行

来扩展

Sub Makro6()

Dim rng As Range, cell As Range

Set rng = Range("C2:C3")

For Each cell In rng
    If cell.Offset(6, 2).Value = 1 Then
        Do
            cell.Value = cell.Value + 1
            SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
            Engine:=2, EngineDesc:="Simplex LP"
            SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
            Engine:=2, EngineDesc:="Simplex LP"
            SolverSolve True
        Loop Until cell.Offset(6, 2).Value = 0
            'Copying cell Value, when Solver solution switched in certain cell depending if it before was 1 or 0
            cell.Copy cell.Offset(6, 3)
            'Copying start value back into cell after solver loop
            cell.Offset(, -1).Copy cell
    Else
        Do
           cell.Value = cell.Value - 1
           SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
           Engine:=2, EngineDesc:="Simplex LP"
           SolverOk SetCell:="$B$16", MaxMinVal:=2, ValueOf:=0, ByChange:="$C$8:$E$9", _
           Engine:=2, EngineDesc:="Simplex LP"
           SolverSolve True
        Loop Until cell.Offset(6, 2).Value = 1
            'Copying cell Value, when Solver solution switched in certain cell depending if it before was 1 or 0
            cell.Copy cell.Offset(6, 4)
            'Copying start value back into cell after solver loop
            cell.Offset(, -1).Copy cell
    End If
Next cell

End Sub

使用Excel Solver的Excel VBA循环，根据特定的不同单元格值复制单元格值

2 个答案: