Excel VBA同时启动多个macros

我有这个代码描绘(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)单元格,并同时开始移动它们?

你的代码

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

照顾第5行。只需再添加这3行为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 

Excel VBA是单线程的。

为了使多个macros同时运行,您可以:

  • 在计时器事件( Application.OnTime )上启动每个macros
  • 确保每个macros定期调用DoEvents以允许其他并发macros运行。

或者,您可以让每个macros运行一次(例如,绘制一个单元格为红色),然后在退出之前调用Application.OnTime来安排下一次执行。

如果您想要同时来回移动几个盒子,请尝试运行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