Zurück zur Homepage

Datum und Zeiteingabe ohne Punkt oder Doppelpunkt

Sie wollen ein Datum eingeben und zwar schnell, ohne zusätzliche Zeichen wie Punkt oder Doppelpunkt? Dann helfen die beiden Funktionen weiter. Sie machen z.B. aus 240160 den 24.01.1960 und aus 1420 die Zeit 14:20. Und zwar als echte Zeit, nicht nur als Anzeige oder Text. Sicherlich kann man auch die Zehnertastatur bei Datumseingaben benutzen und anstatt einen Punkt ein Geteiltzeichen eingeben. Mit dem automatischen Ersetzen von zwei Kommas durch einen Punkt oder zwei Pluszeichen durch ein Doppelpunkt kann man das Eingeben von Zeiten auf die Zehnertastatur beschränken. Ist zwar effektiv, aber auch irgendwie unelegant.

Beispieldatei (datetime.zip 16 kB)

 Public Sub AusZahlDatum(ByVal Target As Excel.Range)
 Dim a, t As Integer, m As Integer, j As Integer
On Error GoTo fehlerbehandlung
a = Target.Value2
If (IsNumeric(a) = False) And (IsDate(a) = False) Then Exit Sub
If (Mid$(a, 5, 4) < 1000) And (a < 10000 Or a > 999999) Then Exit Sub
a = Format(CStr(a), "000000")
t = Mid$(a, 1, 2)
m = Mid$(a, 3, 2)
j = Mid$(a, 5, 4)
a = DateSerial(j, m, t)
Application.EnableEvents = False
Target.Value = a
Target.NumberFormat = "dd.mm.yyyy"
fehlerbehandlung:
Application.EnableEvents = True
End Sub

Public Sub AusZahlZeit(ByVal Target As Excel.Range)
  Dim a
  On Error GoTo fehlerbehandlung
  a = Target.Value2
  If a = "" Then Exit Sub
  If Not (IsNumeric(a) Or IsDate(a)) Then Exit Sub
  a = String(4 - Len(a), Asc("0")) & a
  a = TimeSerial(Left$(a, Len(a) - 2), Right$(a, 2), 0)
  Application.EnableEvents = False
  Target.Value = a
  Target.NumberFormat = "hh:mm"
  fehlerbehandlung:
  Application.EnableEvents = True
End Sub

'Und bei Zelländerung aufrufen vom Ereignis im Klassenmodul des Blatts:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim Zielbereich As Range
  If Target.Count > 1 Then Exit Sub
  'Überprüfen, ob die richtige Zelle für Datum geändert wird
  Set Zielbereich = Application.Intersect(Range("B38"), Target)
  If Not (Zielbereich Is Nothing) Then
    AusZahlDatum Target
  End If
  'Überprüfen, ob die richtige Zelle für Zeit geändert wird
  Set Zielbereich = Application.Intersect(Range("B39"), Target)
  If Not (Zielbereich Is Nothing) Then
    AusZahlZeit Target
  End If
End Sub