Anzeige
Archiv - Navigation
596to600
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
596to600
596to600
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datumseingabe auch 8stellig

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
.

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige