'entwickelt von Winfried Radner 'e-mail: Wolf.W.Radzinski@onlinehome.de 'Benutzung frei - ohne Gewähr Sub auto_open() 'nur für das erste Worksheet (z.B. Tabelle1) Worksheets(1).OnEntry = "Formen" End Sub Sub auto_close() Worksheets(1).OnEntry = "" End Sub Sub Formen() Dim AC As Range Set AC = Application.Caller 'nur die erste Spalte If AC.Column <> 1 Then Exit Sub Select Case Len(AC.FormulaLocal) 'Eingabeformat mjj Case 3: AC = CDate(DateSerial(Right(AC.FormulaLocal, 2), _ Left(AC.FormulaLocal, 1), 1)) 'Eingabeformat mmjj Case 4: AC = CDate(DateSerial(Right(AC.FormulaLocal, 2), _ Left(AC.FormulaLocal, 2), 1)) 'Eingabeformat tmmjj Case 5: AC = CDate(DateSerial(Right(AC.FormulaLocal, 2), _ Mid(AC.FormulaLocal, 2, 2), Left(AC.FormulaLocal, 1))) 'Eingabeformat ttmmjj Case 6: AC = CDate(DateSerial(Right(AC.FormulaLocal, 2), _ Mid(AC.FormulaLocal, 3, 2), Left(AC.FormulaLocal, 2))) 'wenn Eingabe kein Datum Case Else: AC = CVar(AC.Text) 'oder auch Case Else: AC= "kein Datum" End Select End Sub 'angezeigt wird das Datum, lt. Format der Eingabezelle in der Spalte A Eine weitere ziemlich verrückte Möglichkeit Zeit oder Datum nur mit Ziffern in Zellen einzutragen (zufällig aus einer anderen Idee entwickelt!) Folgende CodeZeilen ins Codefenster des gewünschten Tabellenblattes eintragen und zusätzlich das AddIn cb2.xla (ebenfalls auf dieser HP) laden. Wirkung: springt der Cursor in Spalte 1 öffnet sich eine Userform und erwartet Zifferneingabe, jeweils nach 4 eingegebenen Ziffern wird daraus hh:mm:00 in der aktiven Zelle und der Cursor springt 1 Zeile weiter nach unten, die ENTER Taste kopiert die zuletzt eingegebene hh:mm:00 und springt ebenfalls eine Zeile tiefer. Dies wiederholt sich, bis die Userform geschlossen wird - der Cursor steht dann in der ersten - auf diese Weise - gefüllten Zelle. Public old_c As Boolean Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Column = 1 And old_c <> True Then old_c = True Run "cb2.xla!uf", "hhmm", True, 4, "=zeit(links(""x"";2);rechts(""x"";2);0)" Else If Target.Column <> 1 Then old_c = False End If End Sub