|
|
|
|
|
|
Uhrzeitwerte werden oftmals nicht minuten- oder sekundengenau verarbeitet, sondern in angebrochenen Zeitblöcken, etwa in angebrochenen Stunden, halben Stunden, Viertelstunden, Minuten, halben Minuten und dergleichen.
Die beiden folgenden Funktionen NextTimeBlockMinutes und NextTimeBlockSeconds ermitteln den jeweils nächsten glatten Zeitwert zu einem gegebenen Datum/Zeitwert in einem Minuten bzw. Sekunden-Intervall (also das Ende eines angebrochenen Intervalls). Die Intervallstufen sind in einer Enumeration festgelegt, da beliebige krumme Werte wohl kaum sinnvoll sein würden (Sie können diese Vorgabe natürlich auch ignorieren und entsprechend an beliebige Intervall-Werte anpassen). Sowohl Intervall (Voreinstellung 60) als auch Datumswert (Voreinstellung wird als aktueller zeitwert des Systems = Now interpretiert) sind optional.
Public Enum tbIntervalConstants
tb05 = 5
tb10 = 10
tb15 = 15
tb20 = 20
tb30 = 30
tb60 = 60
End Enum
Public Function NextTimeBlockMinutes( _
Optional ByVal Interval As tbIntervalConstants = tb60, _
Optional ByVal DateTime As Date = #1/1/100#) As Date
Dim nNextTimeBlock As Integer
Select Case Interval
Case tb05, tb10, tb15, tb20, tb30, tb60
Case Else
Err.Raise 5
End Select
If DateTime = #1/1/100# Then
DateTime = Now
End If
nNextTimeBlock = Minute(DateTime) Mod Interval
If nNextTimeBlock Then
nNextTimeBlock = Minute(DateTime) - nNextTimeBlock + Interval
Else
If Second(DateTime) Then
nNextTimeBlock = Minute(DateTime) + Interval
Else
nNextTimeBlock = Minute(DateTime)
End If
End If
NextTimeBlockMinutes = CDate(Fix(CDbl(DateTime))) + _
TimeSerial(Hour(DateTime), nNextTimeBlock, 0)
End Function
Public Function NextTimeBlockSeconds( _
Optional ByVal Interval As tbIntervalConstants = tb60, _
Optional ByVal DateTime As Date = #1/1/100#) As Date
Dim nNextTimeBlock As Integer
Select Case Interval
Case tb05, tb10, tb15, tb20, tb30, tb60
Case Else
Err.Raise 5
End Select
If DateTime = #1/1/100# Then
DateTime = Now
End If
nNextTimeBlock = Second(DateTime) Mod 5
If nNextTimeBlock Then
nNextTimeBlock = Second(DateTime) - nNextTimeBlock + 5
End If
NextTimeBlockS05 = CDate(Fix(CDbl(DateTime))) + _
TimeSerial(Hour(DateTime), Minute(DateTime), nNextTimeBlock)
End Function
Den Startzeitpunkt eines angebrochenen Intervalls liefern die beiden folgenden Funktionen StartTimeBlockMinutes und StartTimeBlockSeconds.
Public Function StartTimeBlockMinutes( _
Optional ByVal Interval As tbIntervalConstants = tb60, _
Optional ByVal DateTime As Date = #1/1/100#) As Date
Select Case Interval
Case tb05, tb10, tb15, tb20, tb30, tb60
Case Else
Err.Raise 5
End Select
If DateTime = #1/1/100# Then
DateTime = Now
End If
If Minute(DateTime) Mod Interval = 0 Then
If Second(DateTime) = 0 Then
StartTimeBlockMinutes = DateTime
Exit Function
End If
End If
StartTimeBlockMinutes = DateAdd("n", -Interval, _
NextTimeBlockMinutes(Interval, DateTime))
End Function
Public Function StartTimeBlockSeconds( _
Optional ByVal Interval As tbIntervalConstants = tb60, _
Optional ByVal DateTime As Date = #1/1/100#) As Date
Select Case Interval
Case tb05, tb10, tb15, tb20, tb30, tb60
Case Else
Err.Raise 5
End Select
If DateTime = #1/1/100# Then
DateTime = Now
End If
If Second(DateTime) = 0 Then
StartTimeBlockSeconds = DateTime
Else
StartTimeBlockSeconds = DateAdd("s", -Interval, _
NextTimeBlockSeconds(Interval, DateTime))
End If
End Function
Wenn Sie eine Dauer zwischen zwei Zeitpunkten in aufgerundeten Intervall-Einheiten ermitteln möchten, ergibt sich diese natürlich nicht (!) aus der Differenz zwischen einem nach obigem Muster ermittelten Startzeitpunkt und dem nächsten vollen Intervall-Zeitpunkt. Denn damit könnte das Ergebnis um fast zwei volle Intervalle zu groß werden: nämlich dann, wenn der Startzeitpunkt kurz vor dem nächsten vollen Intervall liegen und abgerundet werden, und der Endzeitpunkt kurz nach einem vollen Intervall liegen und aufgerundet werden würde. Richtiger ist, die tatsächliche Zeitdifferenz auf volle Intervall-Einheiten aufzurunden. Auf diese Weise ermitteln die beiden Funktionen DiffTimeBlockMinutes und DiffTimeBlockSeconds eine glatte Intervall-Zeitdifferenz. Die Endzeit (EndTimeDate, Voreinstellung ergibt aktuelle Systemzeit = Now) und die Intervall-Angabe sind auch hier wieder optional.
Public Function DiffTimeBlockMinutes(ByVal StartDateTime As Date, _
Optional ByVal EndDateTime As Date = #1/1/100#, _
Optional ByVal Interval As tbIntervalConstants = tb60) As Long
Select Case Interval
Case tb05, tb10, tb15, tb20, tb30, tb60
Case Else
Err.Raise 5
End Select
If EndDateTime = #1/1/100# Then
DiffTimeBlockMinutes = DateDiff("n", 0, _
NextTimeBlockMinutes(Interval, Now - StartDateTime), _
vbUseSystemDayOfWeek, vbUseSystem)
Else
DiffTimeBlockMinutes = DateDiff("n", 0, _
NextTimeBlockMinutes(Interval, EndDateTime - StartDateTime), _
vbUseSystemDayOfWeek, vbUseSystem)
End If
End Function
Public Function DiffTimeBlockSeconds(ByVal StartDateTime As Date, _
Optional ByVal EndDateTime As Date = #1/1/100#, _
Optional ByVal Interval As tbIntervalConstants = tb60) As Long
Select Case Interval
Case tb05, tb10, tb15, tb20, tb30, tb60
Case Else
Err.Raise 5
End Select
If EndDateTime = #1/1/100# Then
DiffTimeBlockSeconds = DateDiff("s", 0, _
NextTimeBlockSeconds(Interval, Now - StartDateTime), _
vbUseSystemDayOfWeek, vbUseSystem)
Else
DiffTimeBlockSeconds = DateDiff("s", 0, _
NextTimeBlockSeconds(Interval, EndDateTime - StartDateTime), _
vbUseSystemDayOfWeek, vbUseSystem)
End If
End Function
|
|
|