VBA Tipp: Runden eines Datumswertes auf die nächstgelegene Anzahl von Sekunden

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Es soll der Uhrzeitanteil des Arguments DateTime auf die nächstgelegene Anzahl von Sekunden gerundet werden. Das Argument Truncate erlaubt die Berechnung von Runden auf Abschneiden einzustellen.

Lösung

Public Function RoundTime(Optional ByVal DateTime As Variant, _
                          Optional ByVal RoundToSeconds As Long = 60, _
                          Optional ByVal Truncate As Boolean = False) As Variant
 
   ' DateTime:       (optional) Datum/Uhrzeit-Wert; Standardwert = Now()
   ' RoundToSeconds: (optional) Anzahl der Sekunden, auf die gerundet werden soll;
   '                 Standardwert = 60
   ' Truncate:       (optional) bestimmt, ob der Wert von RoundToSeconds gerundet
   '                 oder abgeschnitten wird; Standardwert = False
   '
   '        z. Bsp.:    60 rundet auf die nächste Minute
   '                   600 rundet auf die nächsten 10 Minuten
   '                   900 rundet auf die nächste Viertelstunde
   '                  3600 rundet auf die nächste Stunde
   '                 86400 rundet auf den nächsten Tag
   '
   ' Funktion gibt Null zurück, falls in DateTime kein gültiges Datum vorliegt.
   ' RoundToSeconds muss ein Wert zwischen 1 und 86400 sein.
   '
   ' Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim Seconds As Long
 
   If IsMissing(DateTime) Then DateTime = VBA.Now()
   If IsDate(DateTime) Then
      If RoundToSeconds < 1 Or RoundToSeconds > 86400 Then RoundToSeconds = 1
      If Truncate Then
         Seconds = RoundToSeconds * (TimeValue(DateTime) * 86400 \ RoundToSeconds)
      Else
         Seconds = RoundToSeconds * CLng(TimeValue(DateTime) * 86400 / RoundToSeconds)
      End If
      RoundTime = DateAdd("s", Seconds, DateValue(DateTime))
   Else
      RoundTime = Null
   End If
End Function

Aufruf

Ergebnisse im Direktfenster anzeigen

   'Auf die nächste Minute runden (Voreinstellung):
   'Beispiel 1:
   Debug.Print Now()                  'ergibt 24.02.2018 12:10:25
   Debug.Print RoundTime(Now())       'ergibt 24.02.2018 12:10:00
 
   'Beispiel 2:
   Debug.Print Now()                  'ergibt 24.02.2018 12:10:45 
   Debug.Print RoundTime(Now())       'ergibt 24.02.2018 12:11:00
 
   'Auf die nächste Stunde runden:
   'Beispiel:
   Debug.Print Now()                  'ergibt 24.02.2018 12:16:40
   Debug.Print RoundTime(Now(), 3600) 'ergibt 24.02.2018 12:00:00