PDA

Vollständige Version anzeigen : Excel 2010/ Datumsvariationen ohne Punkt


Ole1
10.07.2014, 11:17
Hallo,

habe ein Problem mit meiner Datumsformatierung in VBA.
Die Lösungen mit „-„ bzw.“/“ kenne ich bereits. Ich habe auch im Vorfeld ganz viele VBA Funktionen probiert (unter anderem die von Michael Schwimmer). Für mein Problem hat dieses allerdings nicht geholfen.

Ich möchte in meinen Tabellenblatt eine Zahl eingeben bzw. ein Datum und Excel soll mir über die VBA Möglichkeit folgendes Format geben (dd.mm.yyyy). Da ich das Tool nicht alleine nutze sind hier viele Eingabevarianten denkbar, ich habe versucht alle Variationen mit aufzuführen, aber evtl. sind es nicht alle. Also ich fang einfach mal an.

2 Zeichen
z.B.
14 = es soll ein Fenster sich öffnen in dem ich die Auswahl bekomme: 01.04.akt.Jahr oder 14.akt.Monat.akt.Jahr

3 Zeichen
z.B.
104 = es soll ein Fenster sich öffnen in dem ich die Auswahl bekomme: 01.04.akt.Jahr oder 10.04.akt.Jahr

4 Zeichen
z.B.
2104 = 21.04.akt.Jahr

5 Zeichen
z.B.
11114 = es soll ein Fenster sich öffnen in dem ich die Auswahl bekomme: 11.01.2014 oder 01.11.2014

6 Zeichen
z.B.
111114 = 11.11.14

7 Zeichen
z.B.
1112014 = es soll ein Fenster sich öffnen in dem ich die Auswahl bekomme: 11.01.2014 oder 01.11.2014

8 Zeichen
11112014 = 11.11.2014

zu beachten bleibt, dass eine Eingabe mit Punkt z.B. 11.11.14 oder 11.11.2014 trotzdem möglich sein soll und auch im Format dd.mm.yyyy dargestellt werden.

Das Fenster sollte die beiden Datumswerte als Auswahlfeld haben, sowie die Möglichkeit „Ok“ und „Abbrechen“, falls man sich verschrieben hatte.

Für eine Lösung wäre ich mega dankbar.

Liebe Grüße
Ole

Hajo_Zi
10.07.2014, 11:19
du hast die Multiplikation mit 1 vergessen.

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Ole1
10.07.2014, 12:39
ja vielen Dank für den hilfreichen Tipp!

Mc Santa
10.07.2014, 12:42
Hallo,

kannst du vielleicht deine Lösung hier zeigen? Ich würde mich auch dafür interessieren :)

VG

Ole1
10.07.2014, 13:13
Hey Mc Santa,

ne kann ich leider nicht, Multiplikation mit 1 war ja als "Scherz" gemeint.

VG

Hajo_Zi
10.07.2014, 13:19
warum Scherz, das war total ernst gemeint.
Ich habe in meine Code geschaut da ich den sehe, Deinen sehe ich nicht.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Ole1
10.07.2014, 14:23
Hallo Hajo,

ok irgendwas habe ich falsch verstanden. Ich habe keinen Code, habe nur so Bsp. wie dieses probiert:
http://michael-schwimmer.de/vba016.htm

Deinen Code sehe ich leider nicht. Multiplikation mit 1 habe ich daher nicht verstanden. Sorry.

LG
Ole

Hajo_Zi
10.07.2014, 14:26
das ist in Deinen Code nicht notwendig.
Ich baue keine Datei nach, die Zeit hat schon jemand investiert.
Ein Nachbau sieht bestimmt anders aus als das Original.
Ein Link zur Datei oder ein Tabellen Ausschnitt nicht als Bild wäre nicht schlecht.
<br/><b><em>Jul 2014</em></b><table border="1" cellspacing="0" cellpadding="0" style="border-color:#000000; border-width: 1px; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "><colgroup><col style="font-weight:bold; width:40px;" /><col style="width:209px;" /></colgroup><tr style="background-color:#99CCFF; text-align:center; font-weight:bold; "><td>&nbsp;</td><td>C</td></tr><tr><td style="background-color:#99CCFF; text-align:center; font-weight:bold; ">29</td><td style="border-color:#000000; color:#000000; border-color:#000000; background-color:#FFFFFF ;; text-align:right; ">Falsch</td></tr><tr><td style="background-color:#99CCFF; text-align:center; font-weight:bold; ">30</td><td style="border-color:#000000; color:#000000; border-color:#000000; background-color:#FFFFFF ;; text-align:right; ">496</td></tr></table><br/><table border="1" cellspacing="0" cellpadding="0" style="border-color:#000000; border-width: 1px;font-size:11pt; background-color:#ffffff; width:800px;padding-left:2pt; padding-right:2pt; "><tr style="background-color:#FFCC66; text-align:center; font-weight:bold; "><td colspan="3" > verwendete Formeln </td><td> </td></tr><tr valign="top" style="background-color:#FFCC66; text-align:center; font-weight:bold; "><td> Zelle </td><td> Formel</td><td> Bereich </td> <td>N/A</td></tr><tr><td>C29</td><td>=C27=C28</td><td>&nbsp;</td><td>&nbsp;</td></tr><tr><td>C30</td><td>=SUMMEWENN([Bildschirm.xlsm]Statistik!$Q$44:$Q$54;"&lt;" &amp;HEUTE();[Bildschirm.xlsm]Statistik!$R$54)</td><td>&nbsp;</td><td>&nbsp;</td></tr></table><table cellspacing="0" cellpadding="0"><tr style="text-align:left; font-weight:bold; " class="style21"><td style="text-align:left; font-size: xx-small" ><a href="http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip" >Excel-Inn.de</a></td></tr> <tr style="text-align:left; font-weight:bold; " class="style21"><td style="text-align:left; font-size: xx-small" ><a href='http://Hajo-Excel.de/tools.htm' >Hajo-Excel.de</a></td></tr><tr style="text-align:left; font-weight:bold;" ><td style="text-align:left; font-size: xx-small" >XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007</td></tr><tr style="text-align:left; font-weight:bold; " ><td style="text-align:left; font-size: xx-small" > Add-In-Version 18.07 einschl. 64 Bit</td></tr></table><br/>
Benutze hier im Forum die Funktion zum hochladen. Falls Du die nicht benutzen möchtest beachte, von unsicheren Servern wie z.B. www.file-upload.net lade ich keine Datei runter. (lt. Einschätzung meines Virenprogramms)
Der Dateiname sollte was mit dem Problem zu tun haben.
Ich habe mir z.B. einen Ordner angelegt in dem ich alle Dateien aus dem Internet speichere. Bei Dateinamen wie Test..., Mappe…, Beispiel… wird eine vorhandene überschrieben.
Schaue hier, Dateiname im Beitrag (http://www.ms-office-forum.net/forum/showthread.php?t=58538&highlight=Beitrags-Nr#3)
das ist nun das Word -Forum, das gilt hier aber auch.
<b>Ein Bild in Excel geöffnet sieht anders aus als das Bild.</b>

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Ole1
10.07.2014, 14:35
Tabelle kann und darf ich datenschutzrechtlich nicht hochladen, aber ist in dem Fall auch nicht notwendig.

Zur Beschreibung:

Ich möchte ein Datum in eine beliebige Zelle (hier: B7) und Excel soll automatisch mir diese Zahl so in der Zelle darstellen: dd.mm.yyyy

die Eingabevariationen habe ich ja schon aufgeführt. Die Punkte sollen jeweils automatisch über VBA gesetzt werden (Ich weiß es gibt auch die Variante - oder /).

Hajo_Zi
10.07.2014, 14:42
Gut dann sind wir uns ja einig das ich raus bin. Was an einer leeren Datei geschützt werden muss ist mir nicht klar, da der Code schon öffentlich ist.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Ole1
10.07.2014, 15:16
ok... versteh ich weiter nicht...

die Datei ist natürlich nicht leer und der Code der dort öffentlich ist funktioniert nicht in allen Variationen die ich ganz zum Anfang einzeln aufgezählt hat.

Das heißt ich brauche weiter einen VBA Code :(

hary
11.07.2014, 06:50
Moin Ole
Das heißt ich brauche weiter einen VBA Code
Einen!? Da brauchst du schon etwas mehr.
Ist wahrscheinlich einfacher mit dem Nutzer zu ueben bis er kapiert, wie ein Datum in eine Zelle reinzuschreiben ist.
Oder einen Auswahlkalender zeigen lassen wenn in Zelle geklickt wird.
Was ist bei nur einer Zahl. Bsp.: 2
Zu deinen Faellen kommen noch dazu Bsp.: 1.2 oder 1123 oder oder.....
Dann musst du pruefen ob ein Punkt drin ist oder zwei Punkte. Dann pruefen ob die Zahl ueberhaupt ein Datum ergibt usw.
Hab mal ein einfaches Bsp. im Anhang.Ohne evtle. Pruefungen.
In A1 nur 2 oder 3 Zahlen eingeben.
Ich wuerd mal sagen: Vergiss es.
gruss hary

Mc Santa
11.07.2014, 07:17
Hallo,

ich denke in einer Textbox ließe sich dein Vorhaben umsetzen, in einem Tabellenblatt leider nicht.

Ich habe selbst schon einmal eine solche Programmierung versucht und hier ist mein größtes Problem. Ich komme nicht an die Eingabe, die der User ursprünglich gemacht hat. Sobald Excel denkt ein Datum erkannt zu haben, wird ERST das Format auf Datum geändert, und DANN wird das Change-Ereignis ausgelöst.

Und ein weiteres Problem:
Die hat jetzt bereits ein Datumsformat´dann liefern mir folgende Eingaben den gleichen Wert:
1.11.12
1.11.2012
41214
Und ich habe keine Chance heraus zu finden, ob der User die Zahl 41214 eingegeben hat und damit das Datum 4.12.14 meint und das Datum somit umgewandelt werden muss, oder ob der User das Datum 1.11.12 eingegeben hat und das Datum somit schon richtig in der Zelle steht.

Vielleicht hat jemand dazu eine Lösung, ich würde mich auch sehr freuen :)
VG

aloys78
11.07.2014, 08:04
Hallo Ole,
auch ich halte dein Verfahren für den Benutzer kompliziert und für die Umsetzung aufwendig. Gerade bei der Eingabe von 3, 5 und 7 Ziffern gibt es mehrere Datumsmöglichkeiten, und der Benutzer muss dann noch einmal auswählen.

Eine Alternative wäre:
- das Datum 6-stellig einzugeben, zb 010815 ---> 01.08.2015
- vier Ziffern eingeben, zB 0108 ---> 01.08.2014 (akt. Jahr wird ergänzt), oder
- nur 2 Ziffern einzugeben, zB 01 ---> 01.07.2014 (akt. Monat + Jahr werden ergänzt)
Und es wird geprüft, dass die Eingabe-Ziffernfolge identisch (oder ein Teil) ist mit der Ergebnis-Ziffernfolge. Bei deinem mitgelieferten Makro ergibt zB die Zeichenfolge 361314 (für TTMMJJ) das Ergebnis 05.02.2015.

Gruß
Aloys

Ole1
11.07.2014, 11:13
Hallo ihr Lieben,

vielen Dank für eure Rückmeldung. Also ich habe mal so ein Makro gesehen, konnte es aber leider nicht mehr finden. Ich weiß das das Makro relativ lang ist und viele eventualitäten hat. Nichtsdestso trotz möchte ich nicht das so vielen Anwendern sagen, weil unsere anderen Programme mit denen wir auf Arbeit arbeiten auch so ähnlich wie in meiner Schilderung arbeiten.

Ergebnis ist, dass viele das falsch eingeben. Klar kann ich dann eine Datenüberprüfung machen aber am userfreundlichsten wäre das, wenn es hierfür eine VBA Möglichkeit gibt, mit so vielen Variablen.

LG
Ole

Ole1
11.07.2014, 11:41
Hier meine Testversion von Zeile 4-8 aber irgendwie funzt Sie noch nicht:

Private Sub Zieltermin()
Dim Zieltermin As Range
On Error GoTo fehlerbehandlung
If Target.Count > 1 Then Exit Sub
Set Zieltermin = Application.Intersect(Range("B7"), Target)
If Not (Zieltermin Is Nothing) Then
If Len(Zieltermin.Value) = 4 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 1) & ".20" & Right(Zieltermin.Value, 2))
End If

If Len(Zieltermin.Value) = 6 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & ".20" & Right(Zieltermin.Value, 2))
End If

If Len(Zieltermin.Value) = 8 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Right(Zieltermin.Value, 4))
End If

If Len(Zieltermin.Value) = 7 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
End If
End If
End If

If Len(Zieltermin.Value) = 5 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & ".20" & Right(Zieltermin.Value, 2))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & ".20" & Right(Zieltermin.Value, 2))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & ".20" & Right(Zieltermin.Value, 2))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & ".20" & Right(Zieltermin.Value, 2))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & ".20" & Right(Zieltermin.Value, 2))
End If
End If
End If
End If
fehlerbehandlung:
Application.EnableEvents = True

End Sub


Wer kann helfen und ggf. die 3 Version ergänzen?

aloys78
11.07.2014, 17:37
Hallo Mc Santa,
ich denke in einer Textbox ließe sich dein Vorhaben umsetzen, in einem Tabellenblatt leider nicht.
Ich sehe es gerade umgekehrt.
Formatiere die EingabeZellen als Text und nutze das Worksheet_Change Ereignis.
Aber bevor du dein Vorhaben durchziehst, schau dir mal Hary's Demo-Datei an.

Gruß
Aloys

Mc Santa
12.07.2014, 10:43
Hallo Mc Santa,

Ich sehe es gerade umgekehrt.
Formatiere die EingabeZellen als Text und nutze das Worksheet_Change Ereignis.
Aber bevor du dein Vorhaben durchziehst, schau dir mal Hary's Demo-Datei an.

Gruß
Aloys

Hallo,

eine Anforderung die ich an eine solche Funktion hätte, wäre aber auch, dass ich ein bestehendes Datum ändern kann. Dann hat die Zelle, in die ich eingebe, allerdings schon das Datumsformat und ich habe das oben genannte Problem, dass ich nicht mehr unterscheiden kann, was eingegeben wurde :(

VG

aloys78
12.07.2014, 16:20
Hallo Mc Santa,

mal eine vereinfachte Fassung für 2 und 3 Ziffernn. In Sp A werden die Ziffern eingegeben; das Ergebnsi kommt in Sp A als Text und zusätzlich in Sp B und C (von Eingabe abhängig) mit Datumformatierung.

eine Anforderung die ich an eine solche Funktion hätte, wäre aber auch, dass ich ein bestehendes Datum ändern kann.
Möglich - durch Überschreiben der Datum-Bestandteile in Sp A (noch nicht realisiert)
Dann hat die Zelle, in die ich eingebe, allerdings schon das Datumsformat und ich habe das oben genannte Problem, dass ich nicht mehr unterscheiden kann, was eingegeben wurde
Das sehe ich als generelles Problem bei einer DE; da hilft ggf eine Log-Funktion.

Gruß
Aloys

Ole1
15.07.2014, 13:57
Vielen Dank für eure Antworten, könnte jemand vielleicht den Code direkt hier posten.
Darf auf den Arbeitsrechner leider weder Down- noch Uploaden.
Danke.

Hier mein Code mit Worksheet_change, der leider weiter nicht funktioniert:
Private Sub Worksheet_change(ByVal Zieltermin As Range)
On Error GoTo fehlerbehandlung
If Target.Count > 1 Then Exit Sub
Set Zieltermin = Intersect(Zieltermin, Range("B7"))
If Not (Zieltermin Is Nothing) Then
If Len(Zieltermin.Value) = 4 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 1) & ".20" & Right(Zieltermin.Value, 2))
End If

If Len(Zieltermin.Value) = 6 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & ".20" & Right(Zieltermin.Value, 2))
End If

If Len(Zieltermin.Value) = 8 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Right(Zieltermin.Value, 4))
End If

If Len(Zieltermin.Value) = 7 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
End If
End If
End If

If Len(Zieltermin.Value) = 5 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & ".20" & Right(Zieltermin.Value, 2))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & ".20" & Right(Zieltermin.Value, 2))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & ".20" & Right(Zieltermin.Value, 2))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & ".20" & Right(Zieltermin.Value, 2))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & ".20" & Right(Zieltermin.Value, 2))
End If
End If
End If
End If
fehlerbehandlung: Application.EnableEvents = True

End Sub

chris-kaiser
15.07.2014, 14:50
Hi,

hier hatte ich mal was gebastelt

http://www.ms-office-forum.de/forum/showpost.php?p=1285474&postcount=6

funktioniert aber auch nicht zu 100%
:D

aloys78
15.07.2014, 15:59
Hallo,

dann stell ich auch mal meinen Lösungsansatz vor. Wenn die Eingabe über eine Zelle erfolgen soll, dann geht es mE am besten, wenn diese als Text formatiert ist.

Die Eingabe und Anzeige erfolgt in Sp A; die Original-Eingabe wird in Sp E angezeigt; Sp B enthält das bei manchen Zifferneingaben mögliche Alternativ-Ergebnis.

Gruß
Aloys

Ole1
16.07.2014, 07:44
Moin Jungs,

vielen Dank für eure Varianten. Funktionieren super :-)

Könnte mir einer bei meiner Variante beim Code helfen, sodass ich quasi das Auswahlfenster habe in B7, wenn Werte zweideutig sind?

Vielen Dank schon mal im Voraus.

Liebe Grüße
Ole

-> bitte den Code posten (nicht die Datei) :-)

aloys78
16.07.2014, 08:47
Hallo Ole,
Könnte mir einer bei meiner Variante beim Code helfen, sodass ich quasi das Auswahlfenster habe in B7, wenn Werte zweideutig sind?

In deinem vorherigen Beitrag hast du deinen Code vorgestellt, mit der Anmerkung "Hier mein Code mit Worksheet_change, der leider weiter nicht funktioniert:"

Verstehe ich das richtig, du suchst einen Code für ein Auswahlfenster in B7 für eine nicht funktionierende Lösung ?

Gruß
Aloys

Ole1
16.07.2014, 11:25
Hallo Aloys,

doch der soll funktionieren stammt von office Forum.

Hier der Original Code:

Private Sub Zieltermin_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo Fehler

Aktuelles_Jahr = Year(DateValue(Date))
Aktuelles_Jahr_Teil = Left(Aktuelles_Jahr, 2)

If Len(Zieltermin.Value) = 2 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
End If

If Len(Zieltermin.Value) = 4 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
End If

If Len(Zieltermin.Value) = 6 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
End If

If Len(Zieltermin.Value) = 8 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Right(Zieltermin.Value, 4))
End If

If Len(Zieltermin.Value) = 7 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
End If
End If
End If

If Len(Zieltermin.Value) = 5 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
End If
End If
End If

If Len(Zieltermin.Value) = 3 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
End If
End If
End If

Exit Sub

Fehler:
MsgBox "Ihre Eingabe ist nicht in ein Datum formatierbar!", vbCritical, "STOPP!"
Cancel = True
Zieltermin.SetFocus
Zieltermin.Value = ""

End Sub

Ich wollte ihn jetzt aber von MSForms umschreiben, dass wenn Änderungen in Spalte B sind, der Rest Anwendung findet.

Kannst du mir da helfen? Mein Selbstversuch hat leider nicht geklappt

aloys78
16.07.2014, 16:17
Hallo Ole,
doch der soll funktionieren stammt von office Forum.
Dann hast du ihn also noch nicht gestestet !
Ich wollte ihn jetzt aber von MSForms umschreiben, dass wenn Änderungen in Spalte B sind, der Rest Anwendung findet.
Interpretiere das richtig, dass du mit dem Worksheet_Change Ereignis arbeiten möchtest. Nach Eingabe deiner Ziffernkombination soll dann das Makro ausgeführt werden.
Wir haben dich darauf hingewiesen, das dies nur mit Einschränkungen geht. Mc Santa hat den Effekt sehr schön beschrieben.

Sorry, da kann ich nicht helfen.

Gruß
Aloys

Ole1
21.07.2014, 07:03
Hallo Aloys,

ich selber konnte ihn noch nicht testen, habe ihn versucht auf worksheet_change umzubauen, hat aber leider bei mir nicht geklappt, da ich nicht so viele VBA Kenntnisse habe.

Ja die Einschränkungen sind mir bekannt, wollte es trotzdem für mich probieren. Könntest du den Code umschreiben auf Workshett_Change in Spalte B und den Code hier posten?

Ich würde ihn dann testen und alle Einschränkungen schreiben :-)

LG Ole

Mc Santa
21.07.2014, 07:54
Hallo,

wenn du sagst, dass du auf eine Eingabe mit . (Punkt) vollständig verzichten kannst und eine Eingabe ausschließlich als Zahl erfolgt, dann kann man vielleicht den Code dazu schreiben.

Ist das für dich eine Option?

VG

Ole1
21.07.2014, 08:07
Hallo Mc Santa,
hatte aus den anderen Code rausgelesen, dass wenn man das mit "." (Punkt) eingibt, man das Makro nicht startet, also Exit Sub oder Goto verwendet.

Zu der anderen Problematik mit der vorhandenen Eingabe mit dem bereits formatierten, habe ich das Tool jetzt so gestaltet, dass die Eingaben verworfen werden, sobald man dieses schließt, wenigst eine "kleine" Lösung.

LG
Ole

aloys78
21.07.2014, 08:16
Hallo Ole,

du hast eine funktionierende Lösung von mir, die mE alle deine Eingabevarianten abdeckt; du hast sogar darauf geantwortet, dass sie super funktioniert.

Wenn du nun trotzdem ganz andere Wege gehen möchtest, dann ist das deine Sache. Wie man mit dem Worksheet_Change Ereignis arbeitet, kannst du leicht meinem Vorschlag entnehmen.

Gruß
Aloys

Mc Santa
21.07.2014, 08:23
Hallo Mc Santa,
hatte aus den anderen Code rausgelesen, dass wenn man das mit "." (Punkt) eingibt, man das Makro nicht startet, also Exit Sub oder Goto verwendet.

Zu der anderen Problematik mit der vorhandenen Eingabe mit dem bereits formatierten, habe ich das Tool jetzt so gestaltet, dass die Eingaben verworfen werden, sobald man dieses schließt, wenigst eine "kleine" Lösung.

LG
Ole

Hallo,

also in deinem Tool kann man das Datum nur einmal in die Zelle eingeben und danach nicht mehr?
Was macht der User, wenn er sich verschrieben hat? Muss er dann das Tool schließen und erneut (völlig gelöscht) öffnen um eine Eingabe zu korrigieren?

Viele Grüße

Ole1
21.07.2014, 09:44
doch das kann man natürlich.
Nur das wenn man die Datei schließt beim nächsten öffnen der Datumseintrag wieder gelöscht ist

Mc Santa
21.07.2014, 09:57
doch das kann man natürlich.Nur das wenn man die Datei schließt beim nächsten öffnen der Datumseintrag wieder gelöscht ist

Ich glaube, dass genau daran die Code-Umsetzung scheitern wird.

Falls du anderer Meinung bist, dann beschreibe bitte noch einmal, wie du dir die Eingabe genau vorstellst, ich werde meine Einwände dazu geben.

VG

Ole1
21.07.2014, 10:03
ok wäre es nicht anders sinnvoller? Kurz umschreiben auf Worksheet Change und ich gebe Rückmeldung ob es funktioniert oder wenn mir was auffällt, was mir aufgefallen ist. Ist doch besser als 3 Seiten das drumherum zu beschreiben, dieses kann ich ja dann immer noch darauf anpassen.

Bitte einfach mal auf worksheet_change umschreiben in Spalte B:

Private Sub Zieltermin_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo Fehler

Aktuelles_Jahr = Year(DateValue(Date))
Aktuelles_Jahr_Teil = Left(Aktuelles_Jahr, 2)

If Len(Zieltermin.Value) = 2 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
End If

If Len(Zieltermin.Value) = 4 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
End If

If Len(Zieltermin.Value) = 6 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
End If

If Len(Zieltermin.Value) = 8 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 2) & "." & Right(Zieltermin.Value, 4))
End If

If Len(Zieltermin.Value) = 7 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Right(Zieltermin.Value, 4))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Right(Zieltermin.Value, 4))
End If
End If
End If

If Len(Zieltermin.Value) = 5 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Zieltermin.Value, 2))
End If
End If
End If

If Len(Zieltermin.Value) = 3 Then
If Mid(Zieltermin.Value, 2, 2) > 12 Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Else
Datum1 = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Datum2 = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & Datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If Button = vbYes Then
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 1) & "." & Mid(Zieltermin.Value, 2, 2) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
Else
Zieltermin.Value = DateValue(Left(Zieltermin.Value, 2) & "." & Mid(Zieltermin.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Zieltermin.Value, 0))
End If
End If
End If

Exit Sub

Fehler:
MsgBox "Ihre Eingabe ist nicht in ein Datum formatierbar!", vbCritical, "STOPP!"
Cancel = True
Zieltermin.SetFocus
Zieltermin.Value = ""

End Sub

Mc Santa
21.07.2014, 10:31
Hallo,

obwohl der Code hier ziemlich lieblos hingeklatscht wurde, hier mal die Übersetzung als Change-Event.

Das von mir genannte Problem, taucht bei diesem Code nicht auf, da 41214 als Eingabe komplett als Datum abgewiesen wird!! (Sollte sein: 12. Dezember 2014).
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 2 Then
On Error GoTo Fehler

Dim Aktuelles_Jahr As Long
Dim Aktuelles_Jahr_Teil As Long
Dim Datum1 As Date, datum2 As Date
Dim button As Long

Aktuelles_Jahr = Year(DateValue(Date))
Aktuelles_Jahr_Teil = Left(Aktuelles_Jahr, 2)

If Len(Target.Value) = 2 Then
Target.Value = DateValue(Left(Target.Value, 1) & "." & Mid(Target.Value, 2, 1) & "." & Aktuelles_Jahr & "" & Right(Target.Value, 0))
End If

If Len(Target.Value) = 4 Then
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 2) & "." & Aktuelles_Jahr & "" & Right(Target.Value, 0))
End If

If Len(Target.Value) = 6 Then
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Target.Value, 2))
End If

If Len(Target.Value) = 8 Then
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 2) & "." & Right(Target.Value, 4))
End If

If Len(Target.Value) = 7 Then
If Mid(Target.Value, 2, 2) > 12 Then
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Right(Target.Value, 4))
Else
Datum1 = DateValue(Left(Target.Value, 1) & "." & Mid(Target.Value, 2, 2) & "." & Right(Target.Value, 4))
datum2 = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Right(Target.Value, 4))
button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & datum2 & " -> ""Nein""", vbExclamation, "Achtung!")
If button = vbYes Then
Target.Value = DateValue(Left(Target.Value, 1) & "." & Mid(Target.Value, 2, 2) & "." & Right(Target.Value, 4))
Else
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Right(Target.Value, 4))
End If
End If
End If

If Len(Target.Value) = 5 Then
If Mid(Target.Value, 2, 2) > 12 Then
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Target.Value, 2))
Else
Datum1 = DateValue(Left(Target.Value, 1) & "." & Mid(Target.Value, 2, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Target.Value, 2))
datum2 = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Target.Value, 2))
button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If button = vbYes Then
Target.Value = DateValue(Left(Target.Value, 1) & "." & Mid(Target.Value, 2, 2) & "." & Aktuelles_Jahr_Teil & "" & Right(Target.Value, 2))
Else
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Aktuelles_Jahr_Teil & "" & Right(Target.Value, 2))
End If
End If
End If

If Len(Target.Value) = 3 Then
If Mid(Target.Value, 2, 2) > 12 Then
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Target.Value, 0))
Else
Datum1 = DateValue(Left(Target.Value, 1) & "." & Mid(Target.Value, 2, 2) & "." & Aktuelles_Jahr & "" & Right(Target.Value, 0))
datum2 = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Target.Value, 0))
button = MsgBox("Datum kann nicht detektiert werden!" & vbNewLine & _
"" & vbNewLine & _
"Bitte wählen Sie zwischen:" & vbNewLine & _
"" & Datum1 & " -> ""Ja""" & vbNewLine & _
"" & datum2 & " -> ""Nein""", vbExclamation + vbYesNo, "Achtung!")
If button = vbYes Then
Target.Value = DateValue(Left(Target.Value, 1) & "." & Mid(Target.Value, 2, 2) & "." & Aktuelles_Jahr & "" & Right(Target.Value, 0))
Else
Target.Value = DateValue(Left(Target.Value, 2) & "." & Mid(Target.Value, 3, 1) & "." & Aktuelles_Jahr & "" & Right(Target.Value, 0))
End If
End If
End If
End If

Exit Sub
Fehler:
MsgBox "Ihre Eingabe ist nicht in ein Datum formatierbar!", vbCritical, "STOPP!"
'Cancel = True
Target.Value = ""

End Sub


Viele Grüße