Excel VBA多个Application.OnTime

我想在我的子内使用多个Application.OnTime，我正在得到意想不到的结果。

这是我想要做的：

1. 使用“recursion”调用每1分钟运行一个子（testOnTime）

   Inside sub（testOnTime）：

   1. 运行“firstSection”后10秒进入子程序（testOnTime）

      里面的“firstSection”：写debugging信息到Excel工作表“MySheet”

   2. 进入子（testOnTime）后40秒运行“lastSection”

      里面的“lastSection”：写debugging信息到Excel工作表“MySheet”

   3. 将debugging信息写入Excel工作表“Mysheet”

   4. 有子“testOnTime”运行5次？：否 – >继续，是 – >退出

码：

Option Explicit Public rowCnt As Integer Public Cnt As Integer Public Const sheetName = "MySheet" Public Const inc1 = "00:00:40" Public Const inc2 = "00:00:10" Public timeStr1 As Date Public timeStr2 As Date Public timeStr3 As Date Public Sub MyMain() rowCnt = 1 Cnt = 0 Call testOnTime Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "Done" End Sub Public Sub testOnTime() ' wait-time for last section timeStr1 = Format(Now + TimeValue(inc1), "hh:mm:ss") ' wait time for first section timeStr2 = Format(Now + TimeValue(inc2), "hh:mm:ss") ' wait for 1 minute timeStr3 = Format(Now + TimeValue("00:01:00"), "hh:mm:ss") ' wait utill 10 seconds Application.OnTime TimeValue(timeStr2), "firstSection" ' wait utill 40 seconds Application.OnTime TimeValue(timeStr1), "lastSection" ' debug msgs Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "Outside @ " & CStr(timeStr3) Worksheets(sheetName).Range("B" & CStr(rowCnt)).Value = CStr(rowCnt) Worksheets(sheetName).Range("C" & CStr(rowCnt)).Value = CStr(Cnt) rowCnt = rowCnt + 1 Cnt = Cnt + 1 If Cnt < 5 Then ' wait until Now + 1 min Application.OnTime TimeValue(timeStr3), "testOnTime" End If End Sub Public Sub firstSection() ' debug msgs for first section Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "In first section @ " & CStr(timeStr2) Worksheets(sheetName).Range("B" & CStr(rowCnt)).Value = CStr(rowCnt) Worksheets(sheetName).Range("C" & CStr(rowCnt)).Value = CStr(Cnt) rowCnt = rowCnt + 1 End Sub Public Sub lastSection() ' debug msgs for first section Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "In last section @ " & CStr(timeStr1) Worksheets(sheetName).Range("B" & CStr(rowCnt)).Value = CStr(rowCnt) Worksheets(sheetName).Range("C" & CStr(rowCnt)).Value = CStr(Cnt) rowCnt = rowCnt + 1 End Sub 

1. 为什么“Outside …”首先写入Excel表格，当它应该是macros指令里的最后一条指令？

2. 为什么当它只输出一次时，macros输出同样的东西的“两个”信息呢？

3. 有没有更好的方式达到我想要的目标而不使用“OnTime”？

Answer 1

我运行代码，我认为它运行正确 – 我必须承认，我有点困惑，它的目标是什么。 我没有看到任何信息的翻倍。

我可以通过两次运行这个macros来devise一个消息的双倍–Excel很高兴让它运行两次，然后你的消息翻倍。 这是什么原因造成的问题？

我认为你误解了Application.OnTime是如何运行的 – 这是一个非阻塞的调用，所以它创build了对指定子程序的未来调用，然后继续 – 这就是为什么“外部”消息首先被显示。 我认为这也是为什么“完成”消息被立即显示直到它被覆盖。

希望这可以帮助

Answer 2

我想我find了一个方法来实现我想达到的目的，下面是代码

更新代码：

 Option Explicit Public rowCnt As Integer Public Cnt As Integer Public Const sheetName = "MySheet" Public Const inc1 = "00:00:40" Public Const inc2 = "00:00:10" Public timeStr1 As Date Public timeStr2 As Date Public timeStr3 As Date Public firstFlag As Boolean Public lastFlag As Boolean Public Sub MyMain() rowCnt = 1 Cnt = 0 Call testOnTime Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "Done" End Sub Public Sub testOnTime() ' wait-time for last section timeStr1 = Format(Now + TimeValue(inc1), "hh:mm:ss") ' wait time for first section timeStr2 = Format(Now + TimeValue(inc2), "hh:mm:ss") ' wait for 1 minute timeStr3 = Format(Now + TimeValue("00:01:00"), "hh:mm:ss") ' wait utill 10 seconds firstFlag = False Application.OnTime TimeValue(timeStr2), "firstSection" While Not firstFlag DoEvents Wend ' wait utill 40 seconds lastFlag = False Application.OnTime TimeValue(timeStr1), "lastSection" While Not lastFlag DoEvents Wend ' debug msgs Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "Outside @ " & CStr(timeStr3) Worksheets(sheetName).Range("B" & CStr(rowCnt)).Value = CStr(rowCnt) Worksheets(sheetName).Range("C" & CStr(rowCnt)).Value = CStr(Cnt) rowCnt = rowCnt + 1 Cnt = Cnt + 1 If Cnt < 5 Then ' wait until Now + 30 seconds Application.OnTime TimeValue(timeStr3), "testOnTime" End If End Sub Public Sub firstSection() ' debug msgs for first section Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "In first section @ " & CStr(timeStr2) Worksheets(sheetName).Range("B" & CStr(rowCnt)).Value = CStr(rowCnt) Worksheets(sheetName).Range("C" & CStr(rowCnt)).Value = CStr(Cnt) rowCnt = rowCnt + 1 firstFlag = True End Sub Public Sub lastSection() ' debug msgs for first section Worksheets(sheetName).Range("A" & CStr(rowCnt)).Value = "In last section @ " & CStr(timeStr1) Worksheets(sheetName).Range("B" & CStr(rowCnt)).Value = CStr(rowCnt) Worksheets(sheetName).Range("C" & CStr(rowCnt)).Value = CStr(Cnt) rowCnt = rowCnt + 1 lastFlag = True End Sub 

所以，我为每个部分实例化一个标志，标志被设置为FALSE，在macros内部标志将被设置为TRUE。 在Application.OnTime之后，我检查TRUE标志，如果没有，我等待（使用DoEvents）。 这确保在执行非阻塞OnTime之后，程序“等待”，直到该特定的macros已经被执行，然后继续。 这应该是我的目的。