Ausgabe Zeit 0:00 statt 0:30 mit VBA
02.01.2019 11:07:07
Peerli
Zu allererst wünsche ich allen Usern ein gesundes neues Jahr.
Gleich im neuen Jahr beschäftige ich mit meinen liegend gebliebenen Arbeiten, die ich über die Feiertage bei Seite gelegt habe.
Da bin ich auf einen Fehler in meinem Code gestossen, der mich nicht weiterbringt, weil ich den Fehler nicht sehe.
Und zwar...
soll bei Eingabe einer Zahl der formatierte Zeitwert 3stellig in die Zelle eingetragen werden. Bei falscher Eingabe kommt eine Fehlermeldung, je nachdem welche Eingabe getroffen wurde.
In Spalte T kommt die Start-Uhrzeit und in U die Ende-Uhrzeit. In Spalte V die Ist-Zeit und in Spalte W eine festgelegte Soll-Zeit. In Spalte X die Pausenzeit.
Momentan sieht es so aus...
T U V W X
8:00 16:00 ##### 7:48 0:00
und so soll es aussehen...
T U V W X
8:00 16:00 7:48 7:48 0:30
Soweit funktioniert es auch in den Spalten T und U. ur bei Spalte X hat er mit der führenden 0 seine Probleme.
Wenn ich in Spalte T 800 oder 0800 eingebe, wird der richtige Wert 8:00 eingetragen. Ebenso in Spalte U mit 1600. Aber wenn ich in Spalte X 030 eingebe, kommt als Ergebnis 0:00 und somit auch der "falsche" Wert in Spalte V. Die Fehlerroutine nimmt die Spalte X anstandslos an.
Achso, die Zellformatierungen sind bei allen Spalte gleich (Zeitformat)
Anbei der Code
' Procedur zur Zeiteingabe im Bereich Spalte T und U und X vierstellig => Ausgabe [h:mm]
' ************** angepasst von Piet aus www.Herber.de ***************************************** _
_
Dim Eingabe As Variant, fmd As String
On Error GoTo ErrorHandler
If target.Count > 1 Then Exit Sub
If Not Intersect(target, Range("T12:U42,X12:X42")) Is Nothing Then
Application.EnableEvents = False
With target
'Texte und Zahlen > 4 Stellig als Fehler abfangen
If Not IsNumeric(.Value) Then
fmd = "Err": MsgBox "Eingabe ist keine Zahl!!"
' ElseIf .Value 1 And Len(.Value) > 4 Then
fmd = "Err": MsgBox "Bitte nur 4 stellige Zahlen eingeben!"
ElseIf .Value > 1 And fmd = Empty Then
.Value = CDate(Left(.Value, Len(.Value) - 2) & ":" & Right(.Value, 2))
End If
.NumberFormat = "[h]:mm"
End With
End If
ErrorHandler:
If fmd = "Err" Then
target.Value = Empty
target.Select
End If
Application.EnableEvents = True
' *************** Ende *********************************************************************
End Sub
Vielleicht hat jemand einen Rat.LG
Peer