Excel VBA Loop с Excel Solver с копированием значения ячейки в зависимости от определенного значения ячейки

Question

Я новичок в VBA и пытаюсь реализовать Excel Solver Loop. До сих пор я не нашел решения для моей конкретной проблемы, поэтому я надеюсь, что смогу помочь.

Так что я точно делать не является следующее:

1. Использование Solver для минимизации объективной клетки (в данном случае B16)
2. Изменение значения ячейки (C2), столько раз, сколько нужно, до тех пор, (значение становится больше или меньше в зависимости от значения E8, что может быть 1 или 0)
3. Копирование значения этой ячейки в предопределенной ячейке (F8 или G8, в зависимости от
   Значение E8, что может быть 1 или 0)
4. Изменение ячейки V ALUE (C2), чтобы его начальное значение в начале
5. Переключение на следующую ячейку ниже (С3) и изменить значение ячейки до тех пор, пока раствор не изменяет
6. Копирование это значение ячейки в предварительно определенной ячейке (F9 или G9, в зависимости от
   Value от 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

ОК, дайте этому вихрь. Он должен работать на 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 

Answer 2

Я думаю, что вы ищете что-то вроде этого.

ActiveCell.Offset(1,0).Select 

Помните, что всегда (строка, столбец), так что если вы находитесь в ячейке C3, приведенный выше код будет двигаться к C4. Если вы находитесь в ячейке C3 и хотите перейти на D3, вы сделаете это так.

ActiveCell.Offset(0,1).Select