AW: Datumeingabe 00:00:00
09.11.2010 18:49:13
Franz
Hi Frank,
das Essen war gut. Jetzt meine Lösung die du noch anpassen must je nach Spalte(n).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vWert As String
Dim h As Integer, m As Integer, s As Integer, nozero As Integer
'Eingabe-Beispiel: 062345 oder 62345, es folgt als Timerwert: 06:23:45
'2.Beispiel: 34 ergibt als Timerwert: 00:00:34
'If Target.Column 6 Then Exit Sub 'Syntax-Beispiel gelassen
If IsEmpty(Target) Or Selection.Cells.Count > 1 Then Exit Sub
On Error GoTo ERRORHANDLER 'man weiss ja nie!
Select Case Target.Column
Case 5, 7, 9, 11, 13, 15, 17, 19, 21, 23 'Spalten mit Timern
Target.NumberFormat = "hh:mm:ss"
'falls die Formatierung verloren ging. Eine Eingabe "25%" verfälscht die Kontrolle
vWert = Target.Value
If Not IsNumeric(vWert) Then
Target.ClearContents
Target.Select 'mag nicht jeder aber es bringt den Cursor zurück auf die zu prü _
fende Zelle
Exit Sub 'besser
End If
If InStr(Target.Value, ",") Then
Target.ClearContents
Target.Select
Exit Sub
End If
Select Case Len(vWert)
Case 1: vWert = "00:00:0" & vWert
Case 2: vWert = "00:00:" & vWert
Case 3: vWert = "00:0" & Left(vWert, 1) & ":" & Right(vWert, 2)
Case 4: vWert = "00:" & Left(vWert, 2) & ":" & Right(vWert, 2)
Case 5: vWert = "0" & Left(vWert, 1) & ":" & Mid(vWert, 2, 2) & ":" & Right( _
vWert, 2)
Case 6: vWert = Left(vWert, 2) & ":" & Mid(vWert, 3, 2) & ":" & Right(vWert, 2)
Case Is > 6
Target.ClearContents
Target.Select
Exit Sub
End Select
h = Left(vWert, 2): m = Mid(vWert, 4, 2): s = Right(vWert, 2)
If h 24 Then
Target.ClearContents
Target.Select
Exit Sub
End If
If m 60 Then
Target.ClearContents
Target.Select
Exit Sub
End If
If s 60 Then
Target.ClearContents
Target.Select
Exit Sub
End If
nozero = h + m + s
If nozero = 0 Then
Target.ClearContents
Target.Select
Exit Sub
End If
Application.EnableEvents = False
Target.Value = vWert
Application.EnableEvents = True
Case 1, 2, 3, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22 'Spalte mit Text
'hier ohne Korrektur-Massnahmen
End Select
Exit Sub
ERRORHANDLER:
ActiveCell.ClearContents
Application.EnableEvents = True
End Sub
Tschüss!
Franz D.