Question

我试图使用Application OnTime安排两个单独的子程序在Excel VBA中运行。我设法使用下面的代码使其工作-AA每2秒运行一次，BB每5秒运行一次。尽管可以，但是使用6个不同的子弹对我来说有点笨拙。谁能建议使它更简洁的方法？

谢谢。

Dim TimeToRun
Dim TimeToRunBB

Sub Start()
    Call Schedule
    Call ScheduleBB
End Sub

Sub Schedule()
    TimeToRun = Now + TimeValue("00:00:02")
    Application.OnTime TimeToRun, "AA"
End Sub

Sub ScheduleBB()
    TimeToRunBB = Now + TimeValue("00:00:05")
    Application.OnTime TimeToRunBB, "BB"
End Sub

Sub AA()
    Range("A1").Value = Rnd
    Call Schedule
End Sub

Sub BB()
    Range("A2").Value = Rnd
    Call ScheduleBB
End Sub

Sub StopIt()
    Application.OnTime TimeToRun, "AA", , False
    Application.OnTime TimeToRunBB, "BB", , False
End Sub

Answer 1

您可以参数化调度程序：

Private Sub ScheduleExecution(ByVal procedureName As String, ByVal executionTime As Date)
    Application.OnTime executionTime, procedureName
End Sub

但是，实际上，您已经在过程的后面抽象了Application.OnTime方法，而没有从中获得任何好处。

也可以内联。

Public Sub Start()
    Application.OnTime Now + TimeValue("00:00:02"), "AA"
    Application.OnTime Now + TimeValue("00:00:05"), "BB"
End Sub

Now + TimeValue(secondsDelay)部分是多余的。那是值得的功能。

Private Function ToTimeDelay(ByVal hhmmss As String) As Date
    ToTimeDelay = Now + TimeValue(hhmmss)
End Function

现在Start程序不再需要关心参考日期/时间，只需关心偏移量：

Public Sub Start()
    Application.OnTime ToTimeDelay("00:00:02"), "AA"
    Application.OnTime ToTimeDelay("00:00:05"), "BB"
End Sub

拥有可以完成一件事情并且做得很好的小程序的想法一点也不笨拙。这是SOLID（OOP）代码的基本构建块： S 单一责任原则：程序应该只做一件事。请注意，Application.OnTime过程除了调度宏的执行之外，不负责任何其他事情。

您需要清除的是正确的数据结构。您想映射一个过程到一个延迟，并且能够从某个数据结构中检索该过程及其相关的延迟。在VBA中，用于任何 map 的数据结构是Dictionary。

引用 Microsoft脚本运行时类型库。然后，您可以执行以下操作：

Private Property Get ExecutionMap() As Dictionary
    Static map As Dictionary
    If map Is Nothing Then
        Set map = New Dictionary
        map.Add "AA", "00:00:02"
        map.Add "BB", "00:00:05"
    End If
    Set ExecutionMap = map
End Property

现在，您可以仅迭代字典键来调度所有映射的过程，并且可以维护map.Add语句以添加，删除或修改在以下情况下运行的内容：Start过程不再关注什么时间，什么时候-唯一的工作就是安排所有需要安排的程序，无论它们是什么：

Public Sub Start()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
    Next
End Sub

现在，每个过程都可以通过拉相应的键来重新安排自身的时间：

Public Sub AA()
    Const procName As String = "AA"
    ActiveSheet.Range("A1").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

Public Sub BB()
    Const procName As String = "BB"
    ActiveSheet.Range("A2").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

与Stop类似，Start可以简单地再次迭代键：

Public Sub Stop()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName, , False
    Next
End Sub

因此，回顾一下，这给我们留下了一个像这样的模块：

Option Explicit

Private Property Get ExecutionMap() As Dictionary
    Static map As Dictionary
    If map Is Nothing Then
        Set map = New Dictionary
        map.Add "AA", "00:00:02"
        map.Add "BB", "00:00:05"
    End If
    Set ExecutionMap = map
End Property

Private Function ToTimeDelay(ByVal hhmmss As String) As Date
    ToTimeDelay = Now + TimeValue(hhmmss)
End Function

Public Sub Start()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
    Next
End Sub

Public Sub Stop()
    Dim procName As Variant
    For Each procName In ExecutionMap.Keys
        Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName, , False
    Next
End Sub

Public Sub AA()
    Const procName As String = "AA"
    ActiveSheet.Range("A1").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

Public Sub BB()
    Const procName As String = "BB"
    ActiveSheet.Range("A2").Value = Rnd
    Application.OnTime ToTimeDelay(ExecutionMap(procName)), procName
End Sub

模块级变量不见了，维护了要运行的过程的列表，它们各自的延迟现在在一个地方……但这简直就是“简洁”。

如果程序列表不会增加，则无需执行此IMO。另一方面，如果程序列表每周需要更改，并且每次都将其添加到Start和Stop时会令人讨厌地重复，那么您可以考虑 then 提升抽象级别并将该列表拉入Dictionary。

否则，我将删除Call语句，将过程重命名为更有意义的名称，将其命名为“ day”，然后继续;-）

Excel VBA Application.OnTime-两个子代码-更简洁的代码

1 个答案: