Zeit ohne Doppelpunkt Ergänzung mit Tabelle
16.01.2004 23:39:13
Leif Liebscher
Hier nun meine Frage nochmal mit meiner upgeloadeten Tabelle!
Ich möchte Uhrzeiten (halbe und volle Stunden als Start- und Endzeit) ohne Doppelpunkt eingeben, um eine tägliche und insgesamt die wöchentliche Arbeitszeit zu berechnen.
Dazu habe ich ein Makro gefunden das mir die Tipparbeit erleichtern könnte, aber leider
akzeptiert das Makro die Zeiten 0030 Uhr, 0100 Uhr und 0200 Uhr nicht!
Ich habe keine Ahnung von VisualBasic und kann das Makro (Worksheet Change)
nicht korrigieren.
Das angenehme bei dem Makro ist, das man die Uhrzeiten zur vollen Stunde nicht
komplett ausschreiben muss ( 16 = 16:00 usw.).
Halbe Stunden gibt man 1630 ein und erhält 16:30!
Das Makro müsste auch bei aktivem Blattschutz arbeiten, damit meine Arbeitskollegen die Formeln nicht versehentlich überschreiben.
Die Tipps, den Doppelpunkt durch die Autokorrektur und Ähnliches, zu ersetzen kann ich
leider nicht nutzen, da die Stundenberechnung nur Teil einer großen Tabelle ist und es an anderer Stelle dann zu Fehlberechnungen kommt.
Ich brauche Hilfe bei dem Makro, wer weiß Rat? LLiebscher@t-online.de
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%, xpos
If Target.Column < 0 Or Target.Column > 19 Then Exit Sub
' Auslesen der aktuellen Position (Spalte und Zeile)
xSpalte = "" & Target.Column
'Hier umsetzen der Spaltenzahlen ( 2 = B, 3 = C etc.)
Select Case xSpalte
Case 2, 3, 7, 8, 12, 13, 17, 18
xSpalte = Target.Column
xZeile = Target.Row
Case Else
'Rauswerfen wenn andere als o.a. Zeilen
Exit Sub
End Select
'Prüfen ob die ZelenZahl im Bereich 11 - 376 liegt
If xZeile >= 11 And xZeile <= 367 Then
xZeile = Target.Row
Else
'Wenn nicht dann
Exit Sub
End If
With Cells(Target.Row, Target.Column)
If Target.Value = "" Then Exit Sub
xerlaubt$ = "0123456789:,"
xFehler = False
For i = 1 To Len(Target.Value)
b$ = Mid$(Target.Value, i, 1)
If InStr(xerlaubt$, b$) = 0 Then
xFehler = True
End If
Next i
If xFehler = True Then
MsgBox "Bitte geben Sie in dieses Feld eine gültige Uhrzeit im Format HH:MM ein."
Target.Value = ""
Exit Sub
End If
If IsNumeric(Target.Value) And (InStr(Target.Value, ":") = 0 And InStr(Target.Value, ",") = 0) Then
If Len(Target.Value) > 2 Then
xs$ = Left(Target.Value, Len(Target.Value) - 2)
xm$ = Right(Target.Value, 2)
Else
xs$ = Target.Value
xm$ = "00"
End If
If Len(xs$) < 2 Then
xdummy$ = "0" & xs$
xs$ = xdummy$
End If
Target.Value = xs$ & ":" & xm$
If Target.NumberFormat <> "[hh:mm]" Then
' Target.NumberFormat = "[hh:mm]"
End If
'Target.Value = xs$ & ":" & xm$
End If
End With
End Sub
https://www.herber.de/bbs/user/3003.xls