Datumseingabe auch 8stellig

Bild

Betrifft: Datumseingabe auch 8stellig
von: Gisela
Geschrieben am: 12.04.2005 09:18:51
Hallo,
in einem Worksheet-Change formatiere ich die Datumseingabe. Das funktioniert auch u.a. bei einer Eingabe von 6 Stellen, z.B.020505 = 02.05.05. Ich möchte, dass es auch bei der Eingabe von 02052005 = 02.05.05, funktioniert. Was muss ich ändern?
Teilauszug:
'Datum in den Spalten F und G
Set ZielBereich = Application.Intersect(Range("F:G"), Target)
If ZielBereich Is Nothing Then Exit Sub
a = Target.Value
If IsDate(a) = True Then
ActiveSheet.Unprotect ("mix1877")
Application.EnableEvents = False
Target.Value = Format(a, "dd.mm.yy")
Application.EnableEvents = True

ActiveSheet.Protect ("mix1877")

Exit Sub
End If
If IsNumeric(a) = False Then Exit Sub
If a < 10100 Or a > 999999 Then Exit Sub
a = Format(a, "000000")
t = Mid(a, 1, 2)
m = Mid(a, 3, 2)
j = Mid(a, 5, 2)
a = DateSerial(j, m, t)
Application.EnableEvents = False
Kann mir jemand helfen?
Vielen Dank für jeden Tipp.
Grüße
Gisela

Bild

Betrifft: AW: Datumseingabe auch 8stellig
von: bennyhamburg
Geschrieben am: 12.04.2005 09:53:29
hi,
mach aus der Zeile
j = Mid(a, 5, 2)
die folgende
j = Mid(a, 5, 4)
gruß
bennyhamburg
Bild

Betrifft: AW: Datumseingabe auch 8stellig
von: Gisela
Geschrieben am: 12.04.2005 09:58:13
Hallo,
vielen Dank. Hier bekomme ich eine Fehlermeldung. Bei Debugger ist "a = Target.Value" markiert.
Hier mal das gesamte Change

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%
Dim a, t, j, ZielBereich As Range
If Target.Count > 1 Then Exit Sub
'Soll nur bei einer Eingabe in Spalte H und I wirksam werden:
If Target.Column > 7 And Target.Column < 10 Then
    With Cells(Target.Row, Target.Column)
        If .Value = "" Then Exit Sub
        If IsNumeric(.Value) And InStr(.Value, ":") = 0 And InStr(.Value, ",") = 0 Then
        
        ActiveSheet.Unprotect ("mix1877")
        
            .NumberFormat = "[hh]:mm"
            If Len(.Value) > 2 Then
                s = Left(.Value, Len(.Value) - 2)
                m = Right(.Value, 2)
            Else
                s = .Value
                m = 0
            End If
            .Value = s & ":" & m
            
        ActiveSheet.Protect ("mix1877")
            
        End If
    End With
End If
'Datum in den Spalten F und G
Set ZielBereich = Application.Intersect(Range("F:G"), Target)
If ZielBereich Is Nothing Then Exit Sub
a = Target.Value
If IsDate(a) = True Then
ActiveSheet.Unprotect ("mix1877")
    Application.EnableEvents = False
    Target.Value = Format(a, "dd.mm.yy")
    Application.EnableEvents = True
    
ActiveSheet.Protect ("mix1877")
 
    Exit Sub
End If
If IsNumeric(a) = False Then Exit Sub
If a < 10100 Or a > 999999 Then Exit Sub
a = Format(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 = Format(a, "dd.mm.yy")
Application.EnableEvents = True
End Sub

Grüße
Gisela
Bild

Betrifft: AW: Datumseingabe auch 8stellig
von: bennyhamburg
Geschrieben am: 12.04.2005 10:11:26
sorry,
hab grad´ keine Ruhe...
Kann jemand anders helfen? -
Sorry dass ich Verwirrung stifte ;-)))
gruß
bennyhamburg
Bild

Betrifft: AW: Datumseingabe auch 8stellig
von: Volker
Geschrieben am: 12.04.2005 10:58:53
Hallo Gisela,
ohne Deinen Code jetzt bis ins Datail nachzuvollziehen, weil mir das zu kompliziert erscheint:
Die entscheidende Zeile könnte lauten:
Target = Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 2)
Sobald sich Target ändert, wird die WorsheetChange natürlich noch mal angestoßen.
Das mußt Du dann abfangen.
Gruß
Volker
Bild

Betrifft: AW: Datumseingabe immer noch nicht
von: Gisela
Geschrieben am: 12.04.2005 12:36:39
Hallo Volker,
Vielen Dank für Deine Hilfe. Da ich aber nur gerade mit dem Recorder zurechtkomme; kannst Du mir sagen, was bzw. wo ich Deine Zeile einfügen muß?
Grüße
Gisela
Bild

Betrifft: AW: Datumseingabe immer noch nicht
von: Volker
Geschrieben am: 12.04.2005 14:19:42
Hallo Gisela,
so sollte es gehen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%
Dim a, t, j, ZielBereich As Range
If Target.Count > 1 Then Exit Sub
'Soll nur bei einer Eingabe in Spalte H und I wirksam werden:
If Target.Column > 7 And Target.Column < 10 Then
    With Cells(Target.Row, Target.Column)
        If .Value = "" Then Exit Sub
        If IsNumeric(.Value) And InStr(.Value, ":") = 0 And InStr(.Value, ",") = 0 Then
        
            ActiveSheet.Unprotect ("mix1877")
        
            .NumberFormat = "[hh]:mm"
            If Len(.Value) > 2 Then
                s = Left(.Value, Len(.Value) - 2)
                m = Right(.Value, 2)
            Else
                s = .Value
                m = 0
            End If
            .Value = s & ":" & m
            
            ActiveSheet.Protect ("mix1877")
            
        End If
    End With
End If
'Datum in den Spalten F und G
Set ZielBereich = Application.Intersect(Range("F:G"), Target)
If ZielBereich Is Nothing Then Exit Sub
a = Target.Value
If IsDate(a) = True Then
ActiveSheet.Unprotect ("mix1877")
    Application.EnableEvents = False
    Target.Value = Format(a, "dd.mm.yy")
    Application.EnableEvents = True
    
ActiveSheet.Protect ("mix1877")
 
    Exit Sub
End If
If IsNumeric(a) = False Then Exit Sub
If a < 10100 Or a > 31129999 Then Exit Sub
If Len(a) < 7 Then
    a = Format(a, "000000")
Else
    a = Format(a, "00000000")
End If
t = Left(a, 2)
m = Mid(a, 3, 2)
j = Right(a, 2)
a = DateSerial(j, m, t)
Application.EnableEvents = False
Target.Value = Format(a, "dd.mm.yy")
Application.EnableEvents = True
End Sub

Hast Du schon mal dran gedacht, die Eingabe des "." durch Autokorrekturoption zu vereinfachen.
-in "Extras/Autokorrekturoptionen" z.B "++" ersetzen durch ".". Dann kann man ganz bequem Datumsangaben am Zehnerblock eingeben.
-Spalten H und I als Datum formatieren im Format 01.01.02.
Ob Du jetzt "2++2++2005" oder "02++02++05" "2++2++5" eingibst, es kommt immer "02.02.05" raus.
Das geht mit beliebigen Zeichen: ",," durch ":" erstzen und Du kannst vom Zehnerblock aus auch Doppelpunkte schreiben.
Gruß
Volker
Bild

Betrifft: AW: Datumseingabe immer noch nicht
von: Gisela
Geschrieben am: 12.04.2005 15:23:13
Hallo Volker,
sorry, dass ich erst jetzt wieder Zeit habe, hier reinzuschauen.
Vielen Dank für Deine Hilfe. Die ersten Test sind positiv.
Deine Anmerkung werde ich mal in den nächsten Tagen versuchen umzusetzen, im Moment bin ich erst einmal froh, dass es jetzt klappt.
Grüße
Gisela
Bild

Betrifft: Freut mich, wenn's geht (o.T)
von: Volker
Geschrieben am: 12.04.2005 16:06:35
.
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Datumseingabe auch 8stellig"