Excel VBA同時發佈多個宏

Question

我有這個代碼描繪了(B;5)單元格紅色，並開始移動它來回移動。

Declare Sub Sleep Lib "kernel32" (ByVal dwMillisecons As Long) 

Private Sub Button1_Click() 
Move 
End Sub 

Sub Move() 
gr = 1 
st = 1 
While Cells(2, 2) = 0 
If st > 1 Then 
    Cells(5, st - 1).Clear 
    End If 
Cells(5, st + 1).Clear 
Cells(5, st).Interior.Color = vbGreen 
st = st + gr 
If st > 48 Then 
gr = -1 
End If 
If st < 2 Then 
gr = 1 
End If 
Sleep 100 
DoEvents 
Wend 
End Sub 

如何使這將油漆(B;7)和(B,9)細胞，也將開始在同一時間移動它們？

Answer 1

您的代碼

If st > 1 Then Cells(5, st - 1).Clear 
Cells(5, st + 1).Clear 
Cells(5, st).Interior.Color = vbGreen 

照顧5.行的簡單的用於圖7和9

Sub Move() 
    gr = 1 
    st = 1 

    While Cells(2, 2) = 0 
     If st > 1 Then Cells(5, st - 1).Clear 
     Cells(5, st + 1).Clear 
     Cells(5, st).Interior.Color = vbGreen 

     If st > 1 Then Cells(7, st - 1).Clear 
     Cells(7, st + 1).Clear 
     Cells(7, st).Interior.Color = vbGreen 

     If st > 1 Then Cells(9, st - 1).Clear 
     Cells(9, st + 1).Clear 
     Cells(9, st).Interior.Color = vbGreen 

     st = st + gr 

     If st > 48 Then gr = -1 

     If st < 2 Then gr = 1 

     Sleep 100 
     DoEvents 
    Wend 
End Sub 

Answer 2

Excel VBA中是單線程再次添加那些3線。

爲了有多個宏同時運行，您可以：

• 啓動一個定時器事件（Application.OnTime）
• 每個宏確保每個宏調用的DoEvents定期允許其他併發宏運行。

或者，你可以有你的每一個宏的運行一次（例如畫一個紅色的單元格），然後在退出之前，請撥打Application.OnTime安排其下執行。

Answer 3

如果你想獲得幾箱的同時來回移動，然後嘗試運行RTE（）：

Declare Sub Sleep Lib "kernel32" (ByVal dwMillisecons As Long) 
Public BegunA As Boolean 
Public BegunB As Boolean 
Public BegunC As Boolean 
Public wf As WorksheetFunction 

Sub RTE() 
    Dim IAmTheCount As Long 
    BegunA = False 
    BegunB = False 
    BegunC = False 
    Set wf = Application.WorksheetFunction 
    IAmTheCount = 1 

    While IAmTheCount < 50 
     Sleep 100 
     DoEvents 
     Call MoveA 
     Call MoveB 
     Call MoveC 
     IAmTheCount = IAmTheCount + 1 
    Wend 

End Sub 
Sub MoveA() 
    Static gr As Long 
    Static st As Long 
    If Not BegunA Then 
     BegunA = True 
     st = wf.RandBetween(2, 9) 
     gr = wf.RandBetween(1, 2) 
     If gr = 2 Then gr = -1 
    End If 

    Cells(5, 1).EntireRow.Clear 
    Cells(5, st).Interior.Color = vbGreen 
    st = st + gr 

    If st > 10 Then 
     gr = -1 
    End If 

    If st < 2 Then 
     gr = 1 
    End If 
End Sub 
Sub MoveB() 
    Static gr As Long 
    Static st As Long 
    If Not BegunB Then 
     BegunB = True 
     st = wf.RandBetween(2, 9) 
     gr = wf.RandBetween(1, 2) 
     If gr = 2 Then gr = -1 
    End If 

    Cells(6, 1).EntireRow.Clear 
    Cells(6, st).Interior.Color = vbYellow 
    st = st + gr 

    If st > 10 Then 
     gr = -1 
    End If 

    If st < 2 Then 
     gr = 1 
    End If 
End Sub 
Sub MoveC() 
    Static gr As Long 
    Static st As Long 
    If Not BegunC Then 
     BegunC = True 
     st = wf.RandBetween(2, 9) 
     gr = wf.RandBetween(1, 2) 
     If gr = 2 Then gr = -1 
    End If 

    Cells(7, 1).EntireRow.Clear 
    Cells(7, st).Interior.Color = vbRed 
    st = st + gr 

    If st > 10 Then 
     gr = -1 
    End If 

    If st < 2 Then 
     gr = 1 
    End If 
End Sub