Как запустить макрос, если текущее время совпадает с любым значением времени в диапазоне?

Question

У меня есть диапазон значений времени в диапазоне ячеек от D2 до D12. Например, D2 содержит «12:30:00 PM», а D3 - «1:30:00 PM». Некоторые ячейки в диапазоне могут не содержать время, поэтому это динамический c.

Я хотел бы запустить макрос, если текущее время (сейчас) совпадает с любым из времени в диапазоне.

Примерно так:

if Now () = " В любое время в диапазоне «Затем запустите макрос End if

Я пытался применить следующее. Код отсюда Макросы планирования . Но я также заметил, что функция Application.Wait работает лучше, чем использование Application.OnTime. Мне нужна помощь с применением функции Application.Wait для запуска макроса в указанное время в диапазоне.

Public ScheduledTime As Double
Public Const Interval = 5
Public Const MyProc = "MyCode"


Sub MyCode()
Debug.Print Now()
SetOnTime
End Sub

Sub SetOnTime()
ScheduledTime = Now + TimeSerial(0, 0, Interval)
Application.OnTime ScheduledTime, MyProc
End Sub

Answer 1

После поиска и не найденного идеального решения, мне выпала честь построить его

Public ScheduledTime As Double
Public Const MyProc = "MyCode"



Sub MyCode()


'Macro to run
Debug.Print "Hello, this is a scheduled macro" & " " & Format(ScheduledTime, "hh:mm:ss AM/PM")
'Stop

End Sub

Sub SetOnTime()
Dim myArray As Variant, i As Long, numOfTimes As Long
Dim nextTime, newTime, waitTime

'Declare array
myArray = Range("D2:K5").Value
'Remove empty array values to get the exact number of values
'allow room for dynamic range
numOfTimes = Application.WorksheetFunction.CountA(Range("D2:K5"))


'Loop through array values
For i = 1 To numOfTimes

    'get the earliest time from the array
    nextTime = Application.WorksheetFunction.Small(myArray, i)
    ScheduledTime = nextTime

    'Make it possible to change (add or subtract from) scheduled time
    waitTime = ScheduledTime + TimeSerial(0, 0, 0)


    ' Show next time in Status bar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Next Runtime: " & waitTime

    'Make program wait till waitTime and run code
    Application.Wait waitTime
    MyCode

Next i

End Sub