Excel VBA代碼循環

Question

如何循環此代碼，以便它會重複啓動？

Dim i As Long, j As Long, k As Long 
    Dim ws As Worksheet 
    Dim r As Range 

    Sub StartGame() 
     Set ws = ThisWorkbook.Sheets("Sheet1") 
     i = 1: j = 1: k = 1 

     MoveCar1 
    End Sub 

    Sub MoveCar1() 
     With ws 
      Set r = .Cells(6, i) 

      r.Cut 
      r.Offset(, 2).Insert Shift:=xlToRight 
      i = i + 1 
     End With 

     Wait 1 

     MoveCar2 
    End Sub 

    Sub MoveCar2() 
     With ws 
      Set r = .Cells(6, i) 

      r.Cut 
      r.Offset(, 2).Insert Shift:=xlToRight 
      i = i + 1 

      Set r = .Cells(8, j) 

      r.Cut 
      r.Offset(, 2).Insert Shift:=xlToRight 
      j = j + 1 
     End With 

     Wait 1 

     MoveCar3 
    End Sub 

    Sub MoveCar3() 
     With ws 
      Set r = .Cells(6, i) 
      r.Cut 
      r.Offset(, 2).Insert Shift:=xlToRight 
      i = i + 1 

      Set r = .Cells(8, j) 
      r.Cut 
      r.Offset(, 2).Insert Shift:=xlToRight 
      j = j + 1 

      Set r = .Cells(10, k) 
      r.Cut 
      r.Offset(, 2).Insert Shift:=xlToRight 
      k = k + 1 
     End With 

     Wait 1 

     MoveAllCars 
    End Sub 

    Sub MoveAllCars() 
     For l = 1 To 8 
      With ws 
       If i < 9 Then 
        Set r = .Cells(6, i) 
        r.Cut 
        r.Offset(, 2).Insert Shift:=xlToRight 
        i = i + 1 
       End If 

       If j < 9 Then 
        Set r = .Cells(8, j) 
        r.Cut 
        r.Offset(, 2).Insert Shift:=xlToRight 
        j = j + 1 
       End If 

       If k < 9 Then 
        Set r = .Cells(10, k) 
        r.Cut 
        r.Offset(, 2).Insert Shift:=xlToRight 
        k = k + 1 
       End If 

       Wait 1 

       If i > 8 And j > 8 And k > 8 Then Exit For 
      End With 
     Next l 
    End Sub 

    Private Sub Wait(ByVal nSec As Long) 
     nSec = nSec + Timer 
     While nSec > Timer 
      DoEvents 
     Wend 
    End Sub 

You can download it here

該代碼使得細胞（A; 6）（A 8）（A; 10）移動闡述，並且當它們到達細胞（I; 6）（I; 8）（我; 10）他們停下來。

是否有可能循環這段代碼，所以它會一遍又一遍地重複？

Answer 1

您可以通過在您的主分區中放置一個循環，即調用其他分區的循環，但首先需要添加另一個分區以將汽車重置爲開始。

下面是如何將汽車重置一個例子：

Sub ResetCars() 
    If i > 8 Or j > 8 Or k > 8 Then 
     With ws 
      Set r = .Cells(6, i) 
      Set s = .Cells(8, j) 
      Set t = .Cells(10, k) 
      r.Cut 
      .Cells(6, 1).Insert 
      s.Cut 
      .Cells(8, 1).Insert 
      t.Cut 
      .Cells(10, 1).Insert 
     End With 
    End If 
    If (i > 8 And j > 8 And k > 8) = False Then 'deal with the roadblocks 
     bRoadblock = True 
     Range("B6:J10").Value = "" 
    End If 
     Wait 1 
End Sub 

這裏是如何做循環的例子：

Sub StartGame() 
    bRoadblock = False 
    Do Until bRoadblock = True 
     Set ws = ThisWorkbook.Sheets("Sheet1") 
     i = 1: j = 1: k = 1 

     MoveCar1 
     MoveCar2 
     MoveCar3 
     MoveAllCars 
     ResetCars 
    Loop 
End Sub 

通知我如何打電話是所有的其他潛艇的主要分？我從其他潛艇中刪除了這些呼叫，並將它們放在這裏。這是一個更有組織的方式來做到這一點，這樣你就不需要按照鏈條來弄清楚所有東西如何組合在一起。它也有助於條件。假設您決定根據一些標準退出您的MoveCar2子版。一旦你退出，你會去到你所說的那個子的下一個東西。你想在MoveCar1子版或主要子版中做下一件事嗎？

要循環，直到有一個包版，你需要循環知道是否有包版。注意我是如何在那裏放置一個布爾值來告訴它的？你還需要汽車知道有一個障礙，並停下來。

If i < 9 Then 
    If Len(.Cells(6, i + 1).Value) = 0 Then 
     Set r = .Cells(6, i) 
     r.Cut 
     r.Offset(, 2).Insert Shift:=xlToRight 
     i = i + 1 
    Else 
     bRoadblock = True 
    End If 
End If 

類似的東西可以工作。它檢查下一個單元格的值是否長度大於0.如果是，則停止並將障礙設置爲true。如果沒有，那麼它像正常一樣繼續。

請注意，有很多更好的方法來做到這一點。我使用了模塊其餘部分的樣式，因爲您看起來像是初學者，我希望您瞭解解決問題所需的概念。請不要採取錯誤的方式。只要不斷學習。