Datumseingabe auch 8stellig

Forumthread: Datumseingabe auch 8stellig

12.04.2005 09:18:51

Gisela

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 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Datumseingabe auch 8stellig

12.04.2005 09:53:29

bennyhamburg

hi,
mach aus der Zeile
j = Mid(a, 5, 2)
die folgende
j = Mid(a, 5, 4)
gruß
bennyhamburg

AW: Datumseingabe auch 8stellig

12.04.2005 09:58:13

Gisela

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

AW: Datumseingabe auch 8stellig

12.04.2005 10:11:26

bennyhamburg

sorry,
hab grad´ keine Ruhe...
Kann jemand anders helfen? -
Sorry dass ich Verwirrung stifte ;-)))
gruß
bennyhamburg

AW: Datumseingabe auch 8stellig

12.04.2005 10:58:53

Volker

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

AW: Datumseingabe immer noch nicht

12.04.2005 12:36:39

Gisela

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

AW: Datumseingabe immer noch nicht

12.04.2005 14:19:42

Volker

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

AW: Datumseingabe immer noch nicht

12.04.2005 15:23:13

Gisela

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

Freut mich, wenn's geht (o.T)

12.04.2005 16:06:35

Volker

Beliebteste Forumthreads (12 Monate)

Forumthread: Datumseingabe auch 8stellig

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Datumseingabe auch 8stellig

Forumthread: Datumseingabe auch 8stellig

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread