Question

一旦您启动RecordData（）子（从OpenMe（）子），它就可以正常工作。每个时间戳记日志都是连续的，没有双打。当工作簿再次创建（由于OpenMe（）/ Close（）子对象）而重新打开时，是在其创建重复的时间戳记日志时。我可以重新安排OnTime以便在下一个会话中不安排双打吗？还是以某种方式将两个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

'我想每隔一分钟记录/记录一次数据，然后关闭工作簿 '在10分钟内，然后在10秒内重新打开

OnTime时间戳值加倍

1 个答案: