OnTime 时间戳值翻倍

Question

当您启动 RecordData() sub（从 OpenMe() sub）时，它运行完美。每个时间戳日志都是连续的，没有重复。当工作簿再次 re-opens（由于 OpenMe()/Close() subs）时，它会创建重复的时间戳日志。我可以 re-arrange OnTime，这样它就不会为它的下一个 session 安排双打吗？或者以某种方式将两个 OnTime 分开以便它们独立？

Dim NextTime As Double
Sub RecordData()
    Dim Interval As Double
    Dim cel As Range, Capture As Range

    Application.StatusBar = "Recording Started"
    Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
    With Worksheets("Journal") 'Record the data on this worksheet
        Set cel = .Range("A2") 'First timestamp goes here
        Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
        cel.Value = Now
        cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
    End With
    NextTime = Now + TimeValue("00:01:00")
    Application.OnTime NextTime, "RecordData"
End Sub

Sub StopRecordingData()
    Application.StatusBar = "Recording Stopped"
    Application.OnTime NextTime, "OpenMe", , False
End Sub

Sub OpenMe()
    Call RecordData
    Application.OnTime Now + TimeValue("00:10:00"), "CloseMe"
End Sub

Sub CloseMe()
    Application.OnTime Now + TimeValue("00:00:10"), "OpenMe"
    ThisWorkbook.Close True
End Sub

Answer 1

这是一个等待子示例：

注意：此功能仅适用于 excel。

Option Explicit

Dim vntNextTime As Variant
Dim blnStopExecution As Boolean

Const c_strTotalRecordDataWaitTime As String = "00:05:00"
Const c_strCloseAndStopWaitTime As String = "00:00:30"


'This should be on the same sheet as your button!
Private Sub CommandButton1_Click()
    StopRecordingData
End Sub

'Private Sub WaitFor(intHrs As Integer, intMins As Integer, intSecs As Integer)
'    Dim newHour As Integer
'    Dim newMinute As Integer
'    Dim newSecond As Integer
'
'    Dim waitTime As Variant
'
'    newHour = Hour(Now()) + intHrs
'    newMinute = Minute(Now) + intMins
'    newSecond = Second(Now()) + intSecs
'
'    waitTime = TimeSerial(newHour, newMinute, newSecond)
'
'    Application.Wait waitTime
'End Sub

    Private Function CombineTime(intHrs As Integer, intMins As Integer, intSecs As Integer) As Long
        Dim lngTime As Long

        lngTime = intSecs + intMins * 60 + intHrs * 3600
        CombineTime = lngTime
    End Function

    Public Function GetTimeFromString(strInTime As String) As Long
        Dim strSplit() As String
        Dim intHrs As Integer
        Dim intMins As Integer
        Dim intSecs As Integer

        strSplit = Split(strInTime, ":")
        intHrs = CInt(strSplit(0))
        intMins = CInt(strSplit(1))
        intSecs = CInt(strSplit(2))

        GetTimeFromString = CombineTime(intHrs, intMins, intSecs)
    End Function


    Private Sub WaitFor(intHrs As Long, intMins As Long, intSecs As Long)
        Dim newHour As Integer
        Dim newMinute As Integer
        Dim newSecond As Integer
        Dim CurTime As Variant

        Dim waitTime As Variant

        newHour = Hour(Now()) + intHrs
        newMinute = Minute(Now) + intMins
        newSecond = Second(Now()) + intSecs

        waitTime = TimeSerial(newHour, newMinute, newSecond)

        'This is bad practice, but it will work for what you need.
        CurTime = 0
        Do While CurTime < waitTime
            newHour = Hour(Now())
            newMinute = Minute(Now)
            newSecond = Second(Now())

            CurTime = TimeSerial(newHour, newMinute, newSecond)
            DoEvents
            If blnStopExecution Then Exit Do
        Loop
        'Application.Wait waitTime
    End Sub


    Private Function GetNextTime(intHrs As Long, intMins As Long, intSecs As Long) As Variant
        Dim newHour As Integer
        Dim newMinute As Integer
        Dim newSecond As Integer

        Dim vntThisNextTime As Variant

        newHour = Hour(Now()) + intHrs
        newMinute = Minute(Now) + intMins
        newSecond = Second(Now()) + intSecs

        vntThisNextTime = TimeSerial(newHour, newMinute, newSecond)

        GetNextTime = vntThisNextTime
    End Function

    Private Sub RecordData()
        Dim Interval As Double
        Dim cel As Range, Capture As Range
        Dim intI As Integer
        Dim lngTimeStep As Long

        Application.StatusBar = "Recording Started"

        lngTimeStep = GetTimeFromString(c_strTotalRecordDataWaitTime) / 10

        For intI = 0 To 9
            WaitFor 0, 0, lngTimeStep
            If blnStopExecution Then Exit For

            Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
            With Worksheets("Journal") 'Record the data on this worksheet
                Set cel = .Range("A2") 'First timestamp goes here
                Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
                cel.Value = Now
                cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
            End With
        Next intI
    End Sub

    Public Sub OpenMe()
        blnStopExecution = False
        Call RecordData
        Call CloseMe
    End Sub

   Public Sub CloseMe()
        blnStopExecution = True

        vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
        Application.OnTime vntNextTime, "OpenMe"  'Now + TimeValue("00:00:10"), "OpenMe"

        ThisWorkbook.Close True
    End Sub

    Public Sub StopRecordingData()
        blnStopExecution = True
        Application.StatusBar = "Recording Stopped"

        vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
        Application.OnTime vntNextTime, "OpenMe"
    End Sub

'我要log/record一分钟的数据，然后关闭工作簿 '10 分钟后，10 秒后重新打开

OnTime 时间戳值翻倍

OnTime TimeStamp Value Doubling Up

excel

vba

time

rtd

ontime