|
Aus welchem Grunde auch immer Sie gerundete Zeitwerte gebrauchen können - mit Hilfe der Visual Basic-Zeitfunktionen sind "runde Zeiten" kein Problem: Rundungen auf feste Sekunden- oder Minuten-Intervalle (5, 10, 15, 20, 30), auf ganze Minuten, Stunden oder auf ganze Tage.
Das Prinzip beruht bei allen folgenden Funktionen darauf, dass zunächst die Hälfte des Rundungs-Intervalls zur gegebenen Zeit addiert wird. Bei den "vollen" Rundungen (Minuten, Stunden, Tage) wird anschließend der nächst kleinere Bereich abgeschnitten - bei Minuten werden die Sekunden ignoriert, bei Stunden werden die Minuten ignoriert, und bei den Tagen sind es die Stunden. Bei den Intervall-Rundungen wird der Wert des Rundungsbereichs auf einen durch das Intervall teilbaren Wert zurechtgestutzt.
Bei den Funktionen können Sie zusätzlich noch angeben, ob beim übergebenen Datums-/Zeitwert nur der Zeitanteil berücksichtigt und zurückgegeben werden soll, oder ob der Tageswert, soweit vorhanden, erhalten bleiben soll.
Public Enum SecondMinuteStepConstants
sms05 = 5
sms10 = 10
sms15 = 15
sms20 = 20
sms30 = 30
End Enum
Public Function RountToSecondSteps(ByVal DateTime As Date, _
Optional ByVal Steps As SecondMinuteStepConstants = sms15, _
Optional ByVal TimeOnly As Boolean = True) As Date
Dim nTime As Date
Dim nSteps As Integer
Select Case Steps
Case sms05, sms10, sms15, sms20, sms30
Case Else
Err.Raise 5
End Select
nTime = DateAdd("s", Steps / 2, DateTime)
If TimeOnly Then
RountToSecondSteps = TimeSerial(Hour(nTime), Minute(nTime), _
(Second(nTime) \ Steps) * Steps)
Else
RountToSecondSteps = Fix(CDbl(DateTime)) + _
TimeSerial(Hour(nTime), Minute(nTime), _
(Second(nTime) \ Steps) * Steps)
End If
End Function
Public Function RoundToMinutes(ByVal DateTime As Date, _
Optional ByVal TimeOnly As Boolean = True) As Date
Dim nTime As Date
nTime = DateAdd("s", 30, DateTime)
If TimeOnly Then
RoundToMinutes = TimeSerial(Hour(nTime), Minute(nTime), 0)
Else
RoundToMinutes = Fix(CDbl(DateTime)) + TimeSerial(Hour(nTime), _
Minute(nTime), 0)
End If
End Function
Public Function RountToMinuteSteps(ByVal DateTime As Date, _
Optional ByVal Steps As SecondMinuteStepConstants = sms15, _
Optional ByVal TimeOnly As Boolean = True) As Date
Dim nTime As Date
Dim nSteps As Integer
Select Case Steps
Case sms05, sms10, sms15, sms20, sms30
Case Else
Err.Raise 5
End Select
nTime = DateAdd("n", Steps / 2, DateTime)
If TimeOnly Then
RountToMinuteSteps = TimeSerial(Hour(nTime), _
(Minute(nTime) \ Steps) * Steps, 0)
Else
RountToMinuteSteps = Fix(CDbl(DateTime)) + _
TimeSerial(Hour(nTime), (Minute(nTime) \ Steps) * Steps, 0)
End If
End Function
Public Function RoundToHours(ByVal DateTime As Date, _
Optional ByVal TimeOnly As Boolean = True) As Date
If TimeOnly Then
RoundToHours = _
TimeSerial(Hour(DateAdd("n", 30, DateTime)), 0, 0)
Else
RoundToHours = Fix(CDbl(DateTime)) + _
TimeSerial(Hour(DateAdd("n", 30, DateTime)), 0, 0)
End If
End Function
Public Function RoundToDays(ByVal DateTime As Date) As Date
RoundToDays = Fix(CDbl(DateAdd("h", 12, DateTime)))
End Function
|