Zeitformatierung in VBA

Zeitformatierung in VBA: Format DD:HH:MM:SS
A B C
Total: 1 day, 00 hours, 06 min, 23 sec 88350
Total: 1:00:06:23 88350
Total: 24:06:23 88350
Total: 1 day, 00 hours, 06 min, 23 sec = 24:06:23    
In der (ausgeblendeten) Spalte C steht der zu formatierende Zeitwert (in Sekunden)
Funktionsaufruf:
"s" übergibt die Variable in Sekunden und schreibt mit "d" in Tagen/Stunden/Minuten/Sekunden zurück
x = CountTime(w, "s", "d (0), h (1), m (2), s (3)", "d")
"m" übergibt die Variable in Minuten und schreibt mit "h" in Stunden/Minuten/Sekunden zurück
x = CountTime(w, "m", "h (1), m (2), s (3)", "h")
"h" übergibt die Variable in Stunden und schreibt mit "m" in Minuten/Sekunden zurück
x = CountTime(w, "h", "m (2), s (3)", "m")
"d" übergibt die Variable in Tagen und schreibt mit "s" in Sekunden zurück
x = CountTime(w, "d", "s (3)", "s")
Sub Change_Seconds_To_Time_DDHHMMSS()
Dim w, x, y, z
'Format xx Tage, xx Stunden, xx Minuten, xx Sekunden
w = Range("C1").Value
x = CountTime(w, "s", "d (0), h (1), m (2), s (3)", "d")
Range("A1").Value = x
'Format DD:HH:MM:SS
w = Range("C2").Value
y = CountTime(w, "s", "d(0):h(1):m(2):s(3)", "d")
y = Replace(y, "days", "")
y = Replace(y, "day", "")
y = Replace(y, "hours", "")
y = Replace(y, "hour", "")
y = Replace(y, "min", "")
y = Replace(y, "sec", "")
Range("A2").Value = y
'Format HH:MM:SS
w = Range("C3").Value
z = CountTime(w, "s", "h(1):m(2):s(3)", "h")
z = Replace(z, "hours", "")
z = Replace(z, "hour", "")
z = Replace(z, "min", "")
z = Replace(z, "sec", "")
Range("A3").Value = z
'und dann zwei Formatierungen in einer Zelle
z = Replace(z, "Total: ", " = ")
Range("A4").Value = x & z
If w > 1000000 Then w = 1
Range("C1").Value = w + 1567
Range("C2").Value = w + 1567
Range("C3").Value = w + 1567
End Sub
Function:
Function CountTime(ByVal iValue As Long, _
Optional ByVal sInputType As String = "s", _
Optional ByVal sFormat As String = "hh:mm:ss", _
Optional ByVal sMaxValue As String = "d") As String
'Eingabewert in Sekunden umrechnen
Select Case sInputType
Case "m"
iValue = iValue * 60
Case "h"
iValue = iValue * 3600
Case "d"
iValue = iValue * 86400
Case "s"
Case Else
Exit Function
End Select
'MaxValue in schönere Form bringen (zum Rechnen)
Dim iMaxValue As Integer
Select Case sMaxValue
Case "d"
iMaxValue = 0
Case "h"
iMaxValue = 1
Case "m"
iMaxValue = 2
Case "s"
iMaxValue = 3
Case Else
iMaxValue = 0
End Select
Dim d As Long
Dim h As Long
Dim m As Long
Dim s As Long
'Tage ausrechnen
If iMaxValue = 0 Then
d = Int(iValue / 86400)
iValue = iValue - (86400 * d)
End If
'Stunden ausrechnen
If iMaxValue <= 1 Then
h = Int(iValue / 3600)
iValue = iValue - (3600 * h)
End If
'Minuten ausrechnen
If iMaxValue <= 2 Then
m = Int(iValue / 60)
iValue = iValue - (60 * m)
End If
'Rest: Sekunden
s = iValue
Dim dd As String
Dim dh As String
Dim dm As String
Dim ds As String
'ggf. eine Null vor der Zahl einfügen
dd = Format$(d, "00")
dh = Format$(h, "00")
dm = Format$(m, "00")
ds = Format$(s, "00")
'"dd" durch Tage ersetzen (ggf. mit Null)
sFormat = Replace(sFormat, "dd", dd)
If d < 10 Then
'"d" durch Tage ersetzen
sFormat = Replace(sFormat, "d", d)
Else
sFormat = Replace(sFormat, "d", dd)
End If
'"hh" durch Stunden ersetzen (ggf. mit Null)
sFormat = Replace(sFormat, "hh", dh)
'"h" durch Stunden ersetzen
sFormat = Replace(sFormat, "h", dh)
'"mm" durch Minuten ersetzen (ggf. mit Null)
sFormat = Replace(sFormat, "mm", dm)
'"m" durch Minuten ersetzen
sFormat = Replace(sFormat, "m", dm)
'"ss" durch Sekunden ersetzen (ggf. mit Null)
sFormat = Replace(sFormat, "ss", ds)
'"s" durch Sekunden ersetzen
sFormat = Replace(sFormat, "s", ds)
Dim Textd As String
Dim Texth As String
Dim Textm As String
Dim Texts As String
If d = 1 Then Textd = "day" Else Textd = "days"
If h = 1 Then Texth = "hour" Else Texth = "hours"
If m = 1 Then Textm = "min" Else Textm = "min"
If s = 1 Then Texts = "sec" Else Texts = "sec"
'(0) durch Tag / Tage ersetzen
sFormat = Replace(sFormat, "(0)", Textd)
'(1) durch Stunde / Stunden ersetzen
sFormat = Replace(sFormat, "(1)", Texth)
'(2) durch Minute / Minuten ersetzen
sFormat = Replace(sFormat, "(2)", Textm)
'(3) durch Sekunde / Sekunden ersetzen
sFormat = Replace(sFormat, "(3)", Texts)
'(&) durch "und" ersetzen
sFormat = Replace(sFormat, "(&)", "and")
CountTime = "Total: " & sFormat
End Function
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt