Datumseingabe 14022003 zum DATUM 14.02.2003 machen

Hallo,
dieses Posting steht schonmal weeeeit unten im Forum... aber niemand hat mehr auf dieses Posting geantwortet... Deswegen hole ich es jetzt mal nach oben.... In der impertinenten Hoffnung auf eure genialen Kenntnisse
Folgendes Problem: ich möchte in Zelle B2 folgendes eingeben: 14022003 und dann soll da das DATUM 14.02.2003 drinstehen (mit dem man dann auch rechnen kann usw... eben alle Datumsfunktionen nützen)
Es nützt mir nichts wenn das Datum in der Zelle daneben steht (und das ist die Schwierigkeit ;-))) ) Der Datumswert muss genau in der Zelle stehen in der ich das eingegeben habe
PS: mit 00"."##"."#### kann man die eingabe 14022003 schon so formatieren, dass dort 14.02.2003 drinsteht... aber das wird dann als Zahl interpretiert und nicht als Datum :'(
Wer mag sich daran mal den Kopf zerbrechen?????
Ansonsten Schönes Wochenende und Vielen Dank fürs Lesen bis hierhin schonma ;-)
Grüße Chris

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 2 And Target.Row > 1 And Target.Row < 41 Then Application.EnableEvents = False Target = CDate(Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 4)) Application.EnableEvents = True End If End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim Wert As String If Target.Column = 2 And Target.Row > 1 And Target.Row < 41 Then Application.EnableEvents = False Wert = Target.Value If Len(Wert) < 8 Then Wert = "0" & Wert Target = CDate(Left(Wert, 2) & "." & Mid(Wert, 3, 2) & "." & Right(Wert, 4)) Application.EnableEvents = True End If End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim Wert As String If Target.Column = 2 And Target.Row > 1 And Target.Row < 41 Then Wert = Target.Formula If Wert = "" Then Exit Sub Application.EnableEvents = False If Len(Wert) < 8 Then Wert = "0" & Wert Target = CDate(Left(Wert, 2) & "." & Mid(Wert, 3, 2) & "." & Right(Wert, 4)) Application.EnableEvents = True End If End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range) With Target(1) If .Column = intCDate And .Row <= lngRDate Then Application.EnableEvents = False .NumberFormat = "0" If .Value > 10099 And .Value < 31130000 Then .FormulaLocal = WorksheetFunction.Text(.Value, _ "00-00-00" & IIf(1 + .Value > 311299, "00", "")) .NumberFormatLocal = "TT.MM.JJJJ" If Target.Cells.Count > 1 And Target.Columns.Count = 1 Then Target.Value = .Value Target.NumberFormat = .NumberFormat End If End If Application.EnableEvents = True End If End With End Sub

Hallo chris,
hier noch eine kleine Korrektur (Überprüfung der Eingabe erweitert)
Ereigniscode:
Option Explicit
Const intCDate As Integer = 2 'Spalte mit Datumsumwandlung
Const lngRDate As Long = 40 'letzte Zeile mit Datums-Umwandlung


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target(1)
If .Column = intCDate And .Row <= lngRDate Then
If CheckDate(.Formula) = True Then
Application.EnableEvents = False
.NumberFormat = "0"
.FormulaLocal = WorksheetFunction.Text(.Value, _
"00-00-00" & IIf(1 + .Value > 311299, "00", ""))
.NumberFormatLocal = "TT.MM.JJJJ"
.Interior.ColorIndex = .Offset(1).Interior.ColorIndex
If Target.Cells.Count > 1 And Target.Columns.Count = 1 Then .Copy Target
Application.EnableEvents = True
Else
.Interior.ColorIndex = 3
.Activate
End If
End If
End With
End Sub

Code für Modul:
Option Explicit
' prüft ob Zahl einem Datum im Format TMMJJ, TTMMJJ, TMMJJJJ, TTMMJJJJ entspricht
Public Function CheckDate(zahl As Variant) As Boolean
Dim bytUltimo As Byte 'Ultimo
Dim bytDay As Byte 'Tag
Dim bytMon As Byte 'Monat
Dim intYear As Integer 'Jahr
Dim bytNC As Byte 'Korrekturfaktor Länge(n)
Dim lngDatVal As Long 'Datum als Long
Const cstrTitle As String = "Datumskontrolle: EINGABEFEHLER!"
Const cstrError1 As String = "Der Datumsteil "
Const cstrError2 As String = " enthält einen ungültigen Wert!" & vbCr & vbCr
Const cstrInputV As String = "Eingabewert:" & vbTab
lngDatVal = Val(zahl)
If lngDatVal < 10100 Then
MsgBox "In diesem Bereich darf nur eine Datumszahl eingegeben werden!", _
vbCritical + vbOKOnly, cstrTitle
Exit Function
End If
bytNC = Len(CStr(lngDatVal)) Mod 2
bytDay = Left(lngDatVal, 2 - bytNC)
bytMon = Mid(lngDatVal, 3 - bytNC, 2)
intYear = Right(lngDatVal, 2 + (Len(CStr(lngDatVal)) > 6) * -2) + 1900
If intYear < 1930 Then intYear = intYear + 100
Select Case bytMon
Case 0, 13 To 99
MsgBox cstrError1 & "Monat" & cstrError2 _
& cstrInputV & bytMon, _
vbCritical + vbOKOnly, cstrTitle
Exit Function
End Select
bytUltimo = Day(DateSerial(intYear, bytMon + 1, 0))
Select Case bytDay
Case 0, bytUltimo + 1 To 99
MsgBox cstrError1 & "Tag" & cstrError2 _
& cstrInputV & bytDay, _
vbCritical + vbOKOnly, cstrTitle
Exit Function
End Select
CheckDate = True
End Function

Probier's einfach mal...
Servus aus dem Salzkammergut
Franz

Beliebteste Forumthreads (12 Monate)

Datumseingabe 14022003 zum DATUM 14.02.2003 machen

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datumseingabe 14022003 zum DATUM 14.02.2003 machen

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread