Excel VBA Loop with Excel 특정 셀 값에 따라 셀 값을 복사하는 솔버

Question

VBA에 익숙하며 Excel 솔버 루프를 구현하려고합니다. 지금까지는 내 특정 문제에 대한 해결책을 찾지 못했기 때문에 여기서 도움을 얻을 수 있기를 희망합니다. (이 경우 B16에서) 객관적 세포

변경 셀 값 (C2), 필요한만큼 시간을 최소화하기 위해 솔버를 사용

1. 까지 :

   그래서 다음 내가 정확히 뭐하는 거지입니다 (E8의 값에 따라 1 또는 0이 될 수있는 값에 따라 값이 더 크거나 작음)

2. 미리 정의 된 셀 (F8 또는 G8,
   값에 따라 F8 또는 G8에이 셀 값 복사, 1 또는 0)
3. 셀 V 변경 ALUE 시작
4. 스위치 아래 (C3) 다음 셀의 시작 값을 (C2) 및 용액
   값에 따라
5. 복사이 세포 소정 셀의 값 (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

좋아,이 소용돌이. 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