Excel VBA 多个 Application.OnTime

Question

我试图在我的 sub 中使用多个 Application.OnTime，但我得到了意想不到的结果。

这就是我想做的：

1. 使用“递归”调用每 1 分钟运行一次子 (testOnTime)

   内部子（testOnTime）：

   1. 进入 sub (testOnTime) 10 秒后运行“firstSection”

      “firstSection”内部：将调试消息写入 Excel 工作表“MySheet”

   2. 进入 sub (testOnTime) 40 秒后运行“lastSection”

      “lastSection”内部：将调试消息写入 Excel 工作表“MySheet”

   3. 将调试消息写入 Excel 工作表“Mysheet”

   4. 是否有 sub "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. 为什么“外部...”应该是宏内部的最后一条指令，但它会首先写入 Excel 工作表？

2. 为什么宏应该只输出一次却输出“两个”相同的信息？

3. 有没有更好的方法可以在不使用“OnTime”的情况下实现我的预期目标？

Answer 1

我运行了代码，我认为它运行正确 - 我必须承认我对它的目标有点困惑。我没有看到任何重复的消息。

我能够通过运行宏两次来设计消息加倍 - excel 很高兴让它运行两次，然后你会收到加倍的消息。这是导致问题的原因吗？

我认为您误解了 Application.OnTime 的运行方式 - 它是一个非阻塞调用，因此它会创建对指定子例程的未来调用然后继续 - 这就是首先显示“外部”消息的原因。我认为这也是为什么“完成”消息会立即显示直到它被覆盖的原因。

希望对你有帮助

Answer 2

我想我找到了实现我想要实现的方法，下面是代码

更新代码：

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，在宏内部该标志将设置为 TRUE。在 Application.OnTime 之后，我检查 TRUE 标志，如果不是，我等待（使用 DoEvents）。这确保了在执行非阻塞 OnTime 之后，程序“等待”直到该特定宏已被执行，然后再继续。这应该符合我的目的。