excel - Excel 工作表中的独立计时器宏

Question

所以我使用了一个简单的计时器宏，我在网上找到了它，它基本上使用开始和停止按钮来跟踪时间。但是，我想使用计时器，以便它们在每张纸上独立工作。因此，如果我有 2 个工作表，如果我在一张工作表上启动计时器，它会继续在该工作表上运行，我可以切换到第二个工作表并单独在该工作表上启动计时器。目前，宏的工作方式是在一个工作表上启动计时器，在两个工作表上保持运行时间，并且如果在任一工作表上按下任一停止按钮，计时器就会停止。这是我目前拥有的:

Sub StartTimer()
Dim Start As Single, RunTime As Single
Dim ElapsedTime As String
Dim counter As Long

'Set the control cell to 0 and make it green
Range("C1").Value = 0
Range("A1").Interior.Color = 5296274  'Green

counter = 0
Start = Timer 'Set start time.
Debug.Print Start
Do While Range("C1").Value = 0

    DoEvents 'Yield to other processes.
    RunTime = Timer 'Current elapsed time
    ElapsedTime = Format((RunTime - Start) / 86400, "hh:mm:ss")
    'Display currently elapsed time in A1
    Range("A1").Value = ElapsedTime
    Application.StatusBar = ElapsedTime

Loop

Range("A1").Value = ElapsedTime
Range("A1").Interior.Color = 192 'Dark red
Application.StatusBar = False

End Sub

Sub StopTimer()

    'Set the control cell to 1
    Range("C1").Value = 1

End Sub

Sub ResetTimer()
    If Range("C1").Value > 0 Then

    'Set the control cell to 1
    Range("A1").Value = Format(0, "hh:mm:ss")

    End If

End Sub

Answer 1

您可以通过跟踪哪些工作表正在运行计时器来实现此目的。我使用了 Dictionary 和 early binding ，因此您必须添加库引用才能使用下面的示例代码。

这个想法是，您有一个工作簿中哪些工作表具有事件计时器的“列表”。就字典而言，这意味着如果工作表有计时器，则字典中就有一个条目。为了在自己的模块中进行设置，我定义了以下全局常量和变量:

Private Const FIXED_CELL As String = "C20"
Private Const STATUS_CELL As String = "D20"
Private Const UPDATE_INTERVAL As String = "00:00:01"
Private sheetTimers As Dictionary

sheetTimers 字典将被模块中的所有例程使用。常量是一个好主意，因为它为您提供了一个进行更改的地方。

工作簿中的设置是在多个工作表上创建“开始”和“停止”按钮，以及一些用于显示已用时间的单元格。这些按钮将分别分配给相应的Public Sub。

每个子程序中都有代码帮助跟踪计时器并控制下一个 UpdateAllTimers 事件的设置以更新耗时。您可以根据需要修改示例代码以添加单元格颜色和其他功能。

Option Explicit

Private Const ELAPSED_CELL As String = "C5"
Private Const STATUS_CELL As String = "D5"
Private Const UPDATE_INTERVAL As String = "00:00:01"
Private sheetTimers As Dictionary
Private timerIsActive As Boolean

Public Sub UpdateAllTimers()
    If sheetTimers Is Nothing Then
        timerIsActive = False
    Else
        'Debug.Print sheetTimers.Count & " timers are running"
        If sheetTimers.Count > 0 Then
            Dim sheetName As Variant
            For Each sheetName In sheetTimers.Keys
                UpdateElapsedTime sheetName, sheetTimers(sheetName), Now()
            Next sheetName
            Application.OnTime Now() + TimeValue(UPDATE_INTERVAL), "UpdateAllTimers"
            timerIsActive = True
        Else
            timerIsActive = False
        End If
    End If
End Sub

Sub StartTimer()
    '--- first time initialization ONLY
    If sheetTimers Is Nothing Then Set sheetTimers = New Dictionary

    '--- find or create the entry for the ACTIVE worksheet
    Dim thisSheet As Worksheet
    Dim thisSheetName As String
    Set thisSheet = ActiveSheet
    thisSheetName = thisSheet.Name
    If sheetTimers.Exists(thisSheetName) Then
        ResetTimer
    Else
        sheetTimers.Add thisSheetName, Now()
        thisSheet.Range(ELAPSED_CELL).value = TimeValue("00:00:00")
        thisSheet.Range(STATUS_CELL).value = "Running"
    End If

    If Not timerIsActive Then
        Application.OnTime Now() + TimeValue(UPDATE_INTERVAL), "UpdateAllTimers"
    End If
End Sub

Sub StopTimer()
    If sheetTimers Is Nothing Then
        timerIsActive = False
    Else
        '--- update the elapsed time value one last time and delete the
        '    entry in the dictionary
        Dim thisSheet As Worksheet
        Set thisSheet = ActiveSheet

        Dim thisSheetName As String
        thisSheetName = thisSheet.Name
        If sheetTimers.Exists(thisSheetName) Then
            UpdateElapsedTime thisSheetName, sheetTimers(thisSheetName), Now()
            sheetTimers.Remove thisSheetName
            thisSheet.Range(STATUS_CELL).value = "Stopped"
        Else
            '--- do nothing, this sheet's timer was never started
        End If
    End If
End Sub

Private Sub UpdateElapsedTime(ByVal sheetName As String, _
                              ByVal startTime As Date, _
                              ByVal endTime As Date)
    Dim elapsedTime As Range
    Set elapsedTime = ThisWorkbook.Sheets(sheetName).Range(ELAPSED_CELL)
    elapsedTime.NumberFormat = "hh:mm:ss.0"    'optional
    elapsedTime.value = endTime - startTime
End Sub

Sub ResetTimer()
    '--- update the start time value on for the active worksheet
    '    entry in the dictionary
    Dim thisSheet As Worksheet
    Set thisSheet = ActiveSheet

    Dim thisSheetName As String
    thisSheetName = thisSheet.Name
    If sheetTimers.Exists(thisSheetName) Then
        sheetTimers(thisSheetName) = Now()
        UpdateElapsedTime thisSheetName, sheetTimers(thisSheetName), Now()
        sheetTimers.Remove thisSheetName
    Else
        '--- do nothing, this sheet's timer was never started
    End If
End Sub