Вы можете сделать это, отслеживая, какие рабочие листы имеют таймеры выполнения. Я использовал Dictionary с ранним связыванием , поэтому вам придется добавить ссылку на библиотеку, чтобы использовать приведенный ниже пример кода.
Идея состоит в том, что у вас есть "список", из которых рабочие листы в вашей рабочей книге имеют активные таймеры. В терминах Dictionary это означает, что если на листе есть таймер, то в Dictionary есть запись. Чтобы настроить это в своем собственном модуле, я определил следующие глобальные константы и переменную:
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