0

当您启动 RecordData() 子（来自 OpenMe() 子）时，它会完美运行。每个时间戳日志都是连续的，没有双打。当工作簿再次重新打开时（由于 OpenMe()/Close() subs）是它创建重复的时间戳日志的时候。我可以重新安排 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
4

1 回答 1

2

这是一个示例等待子：

注意：此功能仅在 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 秒内重新打开

于 2019-01-23T04:00:20.267 回答