Office 2007: VBA Zeiteingabe

[marth]

Hallo

kennt jemand einen VBA wo mann in Tabelle1 zelle "A3:B30" als zeiteingabe z. B. 5:20,25 nur 520,25 eingeben kann,
5 minuten:20 sekunden, 25 hundertstel.
Danke.

[Officer]

Hallo marth,

ich habe mal schnell eine Lösung per VBA erstellt, die den eingegebenen Wert von bspw. 520,25 wie gewünscht als 5:20,25 in der Zelle darstellt.

Der VBA-Code sieht wie folgt aus und muss beim gewünschten Tabellenblatt hinterlegt werden:

Code: Visual Basic

1. Private Sub Worksheet_Change(ByVal Target As Range)
2.  
3. If Not Application.Intersect(Target, Range("A3:B30")) Is Nothing Then
4.   If Target.Value <> "" Then
5.     Application.EnableEvents = False
6.     pos = InStr(1, Target.Value, ",")
7.     sek = Mid(Target.Value, pos - 2, 2)
8.     minu = Left(Target.Value, pos - 3)
9.     hund = Right(Target.Value, Len(Target.Value) - pos)
10.    
11.     Target.Value = minu & ":" & sek & "," & hund
12.     Application.EnableEvents = True
13.  
14.   End If
15.  
16. End If
17. End Sub
18.  

In der beigefügten Beispieldatei siehst du das Ergebnis.

Gruß

Officer

[Officer]

Hallo marth,

ich habe den VBA-Code soweit modifiziert, dass nun  auch Zahlen ohne Hundertstel-Sekunden korrekt umgesetzt werden.

Wenn es nun eine Zahl z. B. 520,00 oder 1100,00 gibt, kann diese entweder so oder auch ohne Nachkommanangabe z. B. 1100 erfasst werden.

Hier der geänderte Code:

Code: Visual Basic

1. Private Sub Worksheet_Change(ByVal Target As Range)
2.  
3. If Not Application.Intersect(Target, Range("A3:B30")) Is Nothing Then
4.   If Target.Value <> "" Then
5.     Application.EnableEvents = False
6.    
7.     wert = CStr(Target.Value)
8.    
9.     pos = InStr(1, wert, ",")
10.    
11.     If pos = 0 Then
12.       wert = wert & ",00"
13.       pos = Len(wert) - 2
14.     End If
15.     sek = Mid(wert, pos - 2, 2)
16.     minu = Left(wert, pos - 3)
17.     hund = Right(wert, Len(wert) - pos)
18.    
19.     Target.Value = minu & ":" & sek & "," & hund
20.     Application.EnableEvents = True
21.  
22.   End If
23.  
24. End If
25. End Sub
26.  

Gruß Officer

[marth]

wenn ich 520,20 eingebe erscheint   5:20,0 und nicht ,00
wenn ich 52,0 eingebe erscheint   :52,0 und nicht 52,00

[Officer]

Hallo,

so, diese Probleme habe ich auch noch schnell behoben, siehe Code:

Code: Visual Basic

1. Private Sub Worksheet_Change(ByVal Target As Range)
2.  
3. If Not Application.Intersect(Target, Range("A3:B30")) Is Nothing Then
4.   If Target.Value <> "" Then
5.     Application.EnableEvents = False
6.    
7.     wert = CStr(Target.Value)
8.    
9.     pos = InStr(1, wert, ",")
10.    
11.     If pos = 0 Then
12.       wert = wert & ",00"
13.       pos = Len(wert) - 2
14.     End If
15.     sek = Mid(wert, pos - 2, 2)
16.     minu = Left(wert, pos - 3)
17.     hund = Right(wert, Len(wert) - pos)
18.    
19.     If Len(hund) = 1 Then hund = hund & "0"
20.  
21.     If minu = "" Then
22.       trenn = ""
23.     Else
24.       trenn = ":"
25.     End If
26.        
27.     Target.Value = minu & trenn & sek & "," & hund
28.     Application.EnableEvents = True
29.  
30.   End If
31.  
32. End If
33. End Sub
34.  

Gruß

Officer

[marth]

Nochmal vielen Dank, es hat geklappt.