时间戳

首页 > 解决方案 > Excel VBA Application.OnTime - 两个 Subs - 更简洁的代码

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

问题描述

我正在尝试使用 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

标签： excelvbascheduling

解决方案

您可以参数化调度程序过程：

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

让小程序做一件事并做好它的想法一点也不笨拙。它是S OLID (OOP) 代码的基本构建块：单一责任原则：程序应该只做一件事。请注意，Application.OnTime除了调度宏的执行之外，该过程不负责其他任何事情。

为了清理它，您缺少的是正确的数据结构。您希望将过程映射到延迟，并能够从某些数据结构中检索过程及其相关延迟。在 VBA 中，用于任何地图的数据结构是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每次都会令人讨厌地重复，那么是的，那么您可以考虑提高抽象级别并将该列表拉入Dictionary.

否则，我将删除Call语句，将过程重命名为更有意义的名称，收工，然后继续；-)

推荐阅读