Live-Forum - Die aktuellen Beiträge
Datum
Titel
11.05.2024 22:49:27
VBA - NOT-Operator 2 Prozeduren
11.05.2024 22:35:39
Seltsame Code Laufzeit - von 2 Sek. bis 2,5 Minuten!!
11.05.2024 16:41:30
Daten einer XML mit Daten aus einer Zweiten ergänzen
11.05.2024 15:37:35
Excel / VBA Brüche nicht kürzen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1864to1868
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1864to1868
1864to1868
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Umwandlung von Datum

Umwandlung von Datum
27.01.2022 08:49:29
Datum
Hallo Zusammen,
ich nutze folgendes Makro damit ein Datum welches evtl. als Text eingegeben wurde in ein Datumsformat umgewandelt wird - das funktioniert auch bis auf einen Ausnahmefall den ich unten beschreibe:
Columns("Br:Br").Select
With Columns("Br:Br")
.NumberFormat = "General"
.TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
FieldInfo:=Array(1, 4), TrailingMinusNumbers:=True
.NumberFormat = "DD.MM.YYYY"
End With

Nun zu einem Spezialfall, der für mich ein Problem ist:
Wenn in einer entsprechenden Zeile nur eine Jahreszahl steht z.B. 2030, dann wandelt das Makro die Zahl um in 22.07.1905.

Wie muss der Code angepasst werden dass tatsächlich nur ganze Datumsangaben (also "TT.MM.JJJJ") umgewandelt werden - nicht aber die Eingabe von Jahreszahlen - diese sollen einfach stehen bleiben.
Danke für euer Feedback und viele Grüße
Christian

32
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Umwandlung von Datum
27.01.2022 09:05:07
Datum
Hallo Christian,
auf die Schnelle: Nach dem With Columns

If Len(Cells(1, 1) > 4 Then
Vor End With noch ein 

End If
einfügen.
Ist ungetestet.
Gruß Pierre
ich glaube ...
27.01.2022 09:07:38
Pierre
... vor dem Cells fehlt noch ein Punkt, also: 

If Len(.Cells(1, 1) > 4 Then

> 4 ist noch kein Datum
27.01.2022 09:43:30
Michael
Teste besser auf LEN(...) = 10, am besten auch auf AND .Cells(1, 1) like "*.*.*"; womit sichergestellt sein sollte, dass das Format halbwegs stimmt. Dieses Mal findest Du ausnahmsweise nur Jahreszahlen, nächstes Mal ist es ein anderer Fehler. Ich kenn das... ;-)
Grüße
Michael
Anzeige
AW: > 4 ist noch kein Datum
27.01.2022 09:50:54
Pierre
Hallo Michael,
du hast damit zwar Recht, aber mit Prüfung auf 

"= 10"
ist zwingend eine Eingabe mit führenden Nullen erforderlich. Ob das der Fall ist? Weiß man nie so genau.
Natürlich hat meine Variante ebenfalls Nachteile, aber der Wunsch war ja "nur", vierstellige Zahlen auszuschließen, sprich, wenn ledliglich eine Jahreszahl angegeben wurde.
Okay, meine Variante wäre mit 

">= 6"
vielleicht sinnvoller gewesen, dann hat man zumindest T.M.JJJJ als Vorgabe, somit zumindest ein sinnvolles Datum.
Um alle Eventualitäten auszuschließen, benötigt es natürlich noch ein paar weitere Prüfungen.
Gruß Pierre
Anzeige
AW: > 4 ist noch kein Datum
27.01.2022 10:08:12
Chris
Hallo Michael,
Hallo Pierre,
ich habe beide Ansätze ausprobiert, aktuell gibt es aber damit Probleme, auch wenn mir die Prüfung weitgehend klar ist.
Deshalb habe ich hier eine Beispiel Datei hochgeladen, ihr könnt das Makro mal durchlaufen lassen, irgendwas ist da verkehrt, es werden jetzt alle möglichen leeren Zeilen befüllt - inkl. der einfachen Jahreszahlen:
https://www.herber.de/bbs/user/150710.xlsm
Danke für euer Feedback, am besten wäre es wenn ihr den Code dann kopieren könntet dann kann ich leichter testen.
Viele Grüße
Chris
Anzeige
AW: > 4 ist noch kein Datum
27.01.2022 11:11:21
Michael
Hi,
das hat jetzt n Moment gedauert, aber versuche es mal damit:

Sub RepDate()
Dim cell As Range
For Each cell In Range("B1:B" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row)
' len(1.1.2000) = minimal 8 Zeichen
If Len(cell.Value) > 7 And Len(cell.Value)
Meiner Ansicht nach lag es daran, dass Du die Spalte B:B im Ganzen behandelt hast. Man merkte auch, wie es dauert...für drei Zellen...? Dein Code hat alle Millionen Zellen der Spalte abgeklappert, das muss nicht sein.
Folglich musste auch der andere Code anders. Was nicht die Mindestanforderung an ein Datum erfüllt, wird nicht formatiert.
VG
Michael
Anzeige
AW: > 4 ist noch kein Datum
27.01.2022 12:02:00
Chris
Hallo Michael,
danke für deine Rückmeldung, im kleinen funktioniert es.
Im großen File werde ich es separat testen und brauche ggf. noch deine Hilfe da mehrere Spalten in mehreren Tabellenblättern angepasst werden müssen.
Das habe ich in der Vorgängerversion einfach geschafft indem ich einfach den Text kopiert habe und nur die Spalte angepasst habe.
Viele Grüße und danke,
Chris
AW: > 4 ist noch kein Datum
27.01.2022 12:47:18
Michael
Dafür sollte es reichen nach dem "In" mit UNION alle Bereiche zu kombinieren und ihnen den jeweiligen Blattnamen mitzugeben, also

For Each cell In Union(Range("'Tabelle1'!B1:B" & Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row) _
, Range(nächster Bereich) _
)
Da ja nicht formatiert wird, was den Bedingungen nicht entspricht, würde ich einen ELSE-Teil ergänzen, der die nicht behandelten Cells einfärbt:

Else
cell.Interior.ColorIndex = 3 ' das wäre Rot...https://msdn.microsoft.com/de-de/library/office/ff840443.aspx
Grüße
Michael
Anzeige
AW: > 4 ist noch kein Datum
27.01.2022 15:39:55
Chris
Hallo Michael,
danke für deinen Tipp mit Union zu arbeiten. Es funktioniert, allerdings nur innerhalb eines Tabellenblattes. Sobald ich eine Spalte auf einem anderen Blatt hinzufüge kommt der Fehler: "Laufzeitfehler 1004 Die methode Union für das Objekt "Global" ist fehlgeschlagen"
Wäre es dann am besten 3 separate Makros (weil 3 Tabellenblätter) zu haben und diese aneinanderzuketten oder hast du eine andere Lösung?
Viele Grüße und danke nochmal,
Chris
Warum immer noch offen?
27.01.2022 15:44:26
UweD
Prüf doch mal die anderen Lösungsvorschläge
AW: Warum immer noch offen?
27.01.2022 16:25:16
Chris
Hallo Uwe,
danke für den Hinweis, ich werde auch deinen Vorschlag in dem Programm testen.
Aber auch in deinem Vorschlag muss ich ja die Range über mehrere Spalten in verschiedenen Tabellenblättern definieren.
Meine VBA Kenntnisse sind so bescheiden dass ich nicht weiß wie das in deinem Lösungsvorschlag geht:
Set RNG = Columns("B:B")
aber auch nicht in dem vom Michael mit der UNION(Range...)
Die gute Nachricht ist aber dass ich es pro Tabellenblatt zum laufen bekommen habe und jetzt über "CALL" die 3 Ebenen zusammenführen kann ;-)
Schönen Abend und danke für eure Hilfe!
Chris
Anzeige
AW: Warum immer noch offen?
27.01.2022 16:42:36
UweD
Schreib doch mal, wie du genau vorgehen möchtest.
Das Makro kann man dann noch anpassen
AW: Warum immer noch offen?
27.01.2022 17:31:12
Chris
Hallo Uwe,
Hallo Michael,
danke für eure Hilfe. Ich habe jetzt nochmal eine Datei hochgeladen:
https://www.herber.de/bbs/user/150725.xlsm
In dem Screenshot rechts erkennt ihr mein Problem - der Filter wird nicht einheitlich angewendet.
In der Spalte J seht ihr die Lösung, wie es aussehen soll.
Ich habe versucht das Problem zu reparieren, mit dem Makro "Alteversion" das links neben J bereits ausgeführt wurde.
Das funktioniert auch - außer wenn z.B. statt einem "Datum" nur eine Jahreszahl drin steht - dann funktioniert die Altversion nicht.
Die Version von Michael löst leider das Filter Problem nicht - nach dem Durchlauf (makro ist enthalten) ist der Filter wie vorher, kann man im Testfile auch sehen.
Die Version von Uwe gibt mir einen Fehler aus (ebenfalls enthalten), kann man ebenfalls testen.
In dem Excel File habe ich die 3 Versionen mit jeweils einer separaten Datenspalte gegenüber gestellt und dann kann man das Ergebnis besser vergleichen und mit dem "Soll-Zustand" in Spalte J vergleichen.
Ich hoffe dass das mein Problem nochmal verdeutlicht. Die Spalten für die ich das Datum reparieren muss befinden sich auf 3 Tabellen-Blättern, jeweils 4-8 Spalten.
Vielen Dank für eure Unterstützung und einen schönen Abend,
Chris
Anzeige
AW: Warum immer noch offen?
28.01.2022 08:25:34
UweD
Hallo nochmal
Der Fehler kommt durch die eingefügten Überschriften. (Uwe und Datum
versuch es mal so:

Sub Uwe()
Dim TB As Worksheet, SP As Integer, RNG As Range, LR As Long, ZE As Integer, Z
Set TB = Sheets("Tabelle1")
SP = 4 'Spalte D
ZE = 4 ' Erste Datenzeile
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
Set RNG = TB.Cells(ZE, SP).Resize(LR - ZE + 1)
If WorksheetFunction.CountA(RNG) - WorksheetFunction.Count(RNG) > 0 Then
For Each Z In RNG.SpecialCells(xlCellTypeConstants, 2)
Z.Value = CLng(CDate(Z))
Z.NumberFormat = "DD.MM.YYYY"
Next
MsgBox "Datumseinträge repariert", vbInformation, "Verarbeitung erfolgreich!"
Else
MsgBox "Keine falschen Datumseinträge vorhanden", vbInformation, "Verarbeitung beendet!"
End If
End Sub
LG Uwe
Anzeige
für mehrere Spalten...
28.01.2022 09:09:42
UweD
ginge das so

Sub Uwe()
Dim TB As Worksheet, SP, RNG As Range
Dim LR As Long, ZE As Integer, Z, TMP As Boolean
Set TB = ThisWorkbook.Sheets("Tabelle1")
Arr = Array(4, 6, 8)   ' die betroffenen Spalten
ZE = 4 ' Erste Datenzeile
For Each SP In Arr
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
If LR >= ZE Then
Set RNG = TB.Cells(ZE, SP).Resize(LR - ZE + 1)
'Ermittlung ob Text vorhanden
If WorksheetFunction.CountA(RNG) - WorksheetFunction.Count(RNG) > 0 Then
TMP = True
For Each Z In RNG.SpecialCells(xlCellTypeConstants, 2)
Z.Value = CLng(CDate(Z))
Z.NumberFormat = "DD.MM.YYYY"
Next
End If
End If
Next
If TMP Then
MsgBox "Datumseinträge repariert", vbInformation, "Verarbeitung erfolgreich!"
Else
MsgBox "Keine falschen Datumseinträge vorhanden", vbInformation, "Verarbeitung beendet!"
End If
End Sub
LG UweD
Anzeige
AW: für mehrere Spalten...
28.01.2022 09:50:37
Chris
Hallo Uwe,
vielen Dank ich habe die Version mit einer Spalte getestet, das klappt.
Mit den mehreren Spalten wäre für mich noch folgendes interessant zu wissen ob du mir helfen kannst:
Es geht nicht nur darum dass die Spalten mehrere sind, sondern auch dass diese auf 3 verschiedenen Taben verteilt sind, also 3 Taben mit jeweils ca. 5 Spalten.
Zusätzlich habe ich das Problem dass der erste Datensatz einmal in ab Zeile 4 anfängt, aber z.B. in der zweiten Taben ab Zeile 6.
Hättest du hier noch einen Input für mich?
Ansonsten wende ich deinen Lösungsvorschlag in 3 gesonderten Makros für jede Tabe an und fasse es dann über "Call" zusammen.
Viele Grüße und nochmals danke für deinen Input zu dem Thema,
Chris
AW: für mehrere Spalten...
28.01.2022 13:54:33
UweD
Sind es denn auf den jeweiligen Tabellenblätter wenigstens immer die gleichen Spalten, oder ist das auch noch unterschiedlich?
AW: für mehrere Spalten und mehrere Tabellen
28.01.2022 14:58:51
UweD
Also, wenn es immer die gleichen Spalten bei den unterschiedlichen Tabellenblättern sind dann so.
Das Problem mit den unterschiedlichen Startzeilen; die Kleinste angeben.
Überschriften oder sonstiger Text wird nun eleganter berücksichtigt. 

Sub Uwe()
Dim ArrSp, ArrTB, SP, TB, RNG As Range
Dim LR As Long, ZE As Integer, Z, TMP As Integer
ArrTB = Array("Tabelle1", "Tabelle2", "Muster") 'die betroffenen Tabellen
ArrSp = Array(4, 6, 8)   'die betroffenen Spalten
ZE = 4 ' Erste Datenzeile
For Each TB In ArrTB
Set TB = Sheets(TB)
For Each SP In ArrSp
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
If LR >= ZE Then
Set RNG = TB.Cells(ZE, SP).Resize(LR - ZE + 1)
'Ermittlung ob Text vorhanden
If WorksheetFunction.CountA(RNG) - WorksheetFunction.Count(RNG) > 0 Then
For Each Z In RNG.SpecialCells(xlCellTypeConstants, 2)
If IsNumeric(Replace(Z, ".", "")) Then 'Prüfen, ob der Text ein Datum darstellt
TMP = TMP + 1
Z.Value = CLng(CDate(Z))
Z.NumberFormat = "DD.MM.YYYY"
End If
Next
End If
End If
Next
Next
If TMP > 0 Then
MsgBox TMP & " Datumseinträge repariert", vbInformation, "Verarbeitung erfolgreich!"
Else
MsgBox "Keine falschen Datumseinträge vorhanden", vbInformation, "Verarbeitung beendet!"
End If
End Sub
LG UweD
AW: für mehrere Spalten und mehrere Tabellen
28.01.2022 15:11:05
Chris
Hallo Uwe,
danke für deine Rückmeldung, du hast es geahnt ;-) es sind unterschiedliche Spalten in unterschiedlichen Tabellenblättern, bei denen der Datensatz auch nicht nicht in jedem Tabellenblatt gleich anfängt, im ersten Blatt startet es z.b. mit Zeile 4 im nächsten Tabellenblatt ab Zeile 7.
Wahrscheinlich ist es einfacher wenn ich das ursprüngliche Makro einfach verdreifache, für jede Tabe einmal anpasse, ich dachte nur dass es evtl. einfach geht das Array anzupassen.
Viele Grüße
Chris
AW: für mehrere Spalten und mehrere Tabellen
28.01.2022 16:03:56
UweD
Letzter Versuch
Array("Tabelle1;4", "Tabelle1;6", "Tabelle1;8", "Tabelle2;2", "Tabelle2;3", "Tabelle2;8", "Muster;2")
Bedeutet:
- Tabelle1 Spalten 4, 6 ,8
- Tabelle2 Spalten 3, 3 ,8
- Muster Spalten 2
Die Trennung Blattname und Zelle muss ein Semikolon sein
Anfangszeile ist egal. Die Kleinste solltest du angeben

Sub Uwe()
Dim TB, Blatt, ArrTB, SP, RNG As Range
Dim LR As Long, ZE As Integer, Z, TMP As Integer
ArrTB = Array("Tabelle1;4", "Tabelle1;6", "Tabelle1;8", "Tabelle2;2", "Tabelle2;3", "Tabelle2;8", "Muster;2")
ZE = 4 ' Erste Datenzeile
For Each Blatt In ArrTB
Set TB = Sheets(Split(Blatt, ";")(0))
SP = CInt(Split(Blatt, ";")(1))
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
If LR >= ZE Then
Set RNG = TB.Cells(ZE, SP).Resize(LR - ZE + 1)
'Ermittlung ob Text vorhanden
If WorksheetFunction.CountA(RNG) - WorksheetFunction.Count(RNG) > 0 Then
For Each Z In RNG.SpecialCells(xlCellTypeConstants, 2)
If IsNumeric(Replace(Z, ".", "")) Then 'Prüfen, ob der Text ein Datum darstellt
TMP = TMP + 1
Z.Value = CLng(CDate(Z))
Z.NumberFormat = "DD.MM.YYYY"
End If
Next
End If
End If
Next
If TMP > 0 Then
MsgBox TMP & " Datumseinträge repariert", vbInformation, "Verarbeitung erfolgreich!"
Else
MsgBox "Keine falschen Datumseinträge vorhanden", vbInformation, "Verarbeitung beendet!"
End If
End Sub
LG UweD
noch eine Idee
28.01.2022 16:12:29
UweD
Wäre es möglich, die Tabellen anzugeben ( so wie schon gehabt) und innerhalb Dieser dann nach den Überschriften "Datum" zu suchen
Die Spalte der Fundstellen dann abarbeiten? Oder sind weitere Datum enthalten, die nicht abgearbeitet werden sollen
AW: für mehrere Spalten und mehrere Tabellen
28.01.2022 15:49:58
Chris
Hallo Uwe,
ich bekomme, bei einer der Spalten eine Fehlermeldung in der Zeile: Z.Value = CLng(CDate(Z))
Laufzeitfehler 13, Typen unverträglich.
Da es sich um viele Zeilen handelt weiß ich aktuell nicht welcher Eintrag den Fehler auslöst.
Hast du noch eine Idee? Schönes Wochenende schonmal und viele Grüße,
Chris
AW: für mehrere Spalten und mehrere Tabellen
28.01.2022 16:19:39
UweD
Öffne mal das Direktfenster und beobachte
Ich hab noch eine Protokollzeile eingebaut um den Fehler zu finden

Sub Uwe()
Dim TB, Blatt, ArrTB, SP, RNG As Range
Dim LR As Long, ZE As Integer, Z, TMP As Integer
ArrTB = Array("Tabelle1;4", "Tabelle1;6", "Tabelle1;8", "Tabelle2;2", "Tabelle2;3", "Tabelle2;8", "Muster;2")
ZE = 4 ' Erste Datenzeile
For Each Blatt In ArrTB
Set TB = Sheets(Split(Blatt, ";")(0))
SP = CInt(Split(Blatt, ";")(1))
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
If LR >= ZE Then
Set RNG = TB.Cells(ZE, SP).Resize(LR - ZE + 1)
'Ermittlung ob Text vorhanden
If WorksheetFunction.CountA(RNG) - WorksheetFunction.Count(RNG) > 0 Then
For Each Z In RNG.SpecialCells(xlCellTypeConstants, 2)
Debug.Print "Blatt:"; TB.Name; "   Spalte:"; SP; "Zeile:"; Z.Row
If IsNumeric(Replace(Z, ".", "")) Then 'Prüfen, ob der Text ein Datum darstellt
TMP = TMP + 1
Z.Value = CLng(CDate(Z))
Z.NumberFormat = "DD.MM.YYYY"
End If
Next
End If
End If
Next
If TMP > 0 Then
MsgBox TMP & " Datumseinträge repariert", vbInformation, "Verarbeitung erfolgreich!"
Else
MsgBox "Keine falschen Datumseinträge vorhanden", vbInformation, "Verarbeitung beendet!"
End If
End Sub
Bin jetzt offline
AW: für mehrere Spalten und mehrere Tabellen
28.01.2022 17:00:39
Chris
Hi Uwe,
das mit den verschiedenen Spalten funktioniert soweit, vielen Dank.
Ich weiß jetzt woher die Fehlermeldung kommt: Ein Datumseintrag lautet : 31.09.2021 da es das Datum nicht gibt kommt der Fehler.
Kann man dann für solche Fälle den Eintrag überspringen lassen und ggf. einfach nur Farblich auffällig markieren? Es soll nicht das ganze Makro stoppen, solche Einträge sind zwar sinnlos kommen aber immer wieder mal vor.
Schönes WE, ich bin jetzt auch erstmal offline
Chris
AW: für mehrere Spalten und mehrere Tabellen
28.01.2022 22:16:34
Michael
Hallo nochmal,
wie schön, das Datumsfilterproblem ist gelöst. Die Idee, der Zelle ihren Wert gecastet nochmal zuzuweisen hatte ich inzwischen auch, schön, dass das tatsächlich funktioniert. "Zu Fuß" hab ich bisher immer alles in einen Texteditor kopiert, dann in "frische" Zellen einer neuen Mappe, dann wieder zurück zum Ausgangspunkt. Manchmal half auch das nichts. Woher kommt dieser Zustand der Zellen? Sind die irgendwie defekt? Einmal reingekickt, Enter gedrückt, alles ist gut. Aber das kann man natürlich nicht hundertfach machen,
Zum 31.09. würde ich gerne noch was beitragen, allerdings nicht in Uwes Code, dafür ist es zu spät...
Ein Try...Catch scheint es in vba nicht zu geben. Aber goto ist auch mal wieder schön ;-)
https://www.herber.de/bbs/user/150747.xlsm
Viele Grüße
Michael
AW: für mehrere Spalten und mehrere Tabellen
31.01.2022 14:40:15
UweD
Hallo nochmal
Fehlerhaftes Datum wird rot und es kommt eine Meldung. Makro läuft aber dann weiter

Option Explicit
Sub Uwe()
Dim TB, Blatt, ArrTB, SP, RNG As Range
Dim LR As Long, ZE As Integer, Z, TMP As Integer
ArrTB = Array("Tabelle1;4", "Tabelle1;6", "Tabelle1;8", "Tabelle2;2", "Tabelle2;3", "Tabelle2;8", "Muster;2")
ZE = 4 ' Erste Datenzeile
For Each Blatt In ArrTB
Set TB = Sheets(Split(Blatt, ";")(0))
SP = CInt(Split(Blatt, ";")(1))
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
If LR >= ZE Then
Set RNG = TB.Cells(ZE, SP).Resize(LR - ZE + 1)
'Ermittlung ob Text vorhanden
If WorksheetFunction.CountA(RNG) - WorksheetFunction.Count(RNG) > 0 Then
For Each Z In RNG.SpecialCells(xlCellTypeConstants, 2)
'zum testen*
'Debug.Print "Blatt: "; TB.Name; "   Spalte:"; SP; "  Zeile:"; Z.Row; "   "; Z
If IsNumeric(Replace(Z, ".", "")) Then 'Prüfen, ob der Text ein Datum darstellt
TMP = TMP + 1
If Not IsDate(Z.Value) Then
MsgBox "Blatt: " & TB.Name & ";  Spalte: " & SP & ";  Zeile: " & Z.Row & ";  " & Z, , _
"Kein gültiges Datum"
Z.Font.Color = vbRed
Else
Z.Value = CLng(CDate(Z))
Z.NumberFormat = "DD.MM.YYYY"
End If
End If
Next
End If
End If
Next
If TMP > 0 Then
MsgBox TMP & " Datumseinträge repariert", vbInformation, "Verarbeitung erfolgreich!"
Else
MsgBox "Keine falschen Datumseinträge vorhanden", vbInformation, "Verarbeitung beendet!"
End If
End Sub
LG UweD
AW: für mehrere Spalten und mehrere Tabellen
31.01.2022 16:43:46
Chris
Hallo Uwe,
das ist klasse, was da alles möglich ist, da hab ich viel zu lernen und werde mir den Code genauer ansehen. Vielen Dank für deinen finalen Lösungsvorschlag, das funktioniert wirklich ausgezeichnet!!
LG
Chris
Prima. Danke für die Rückmeldung. mwT
01.02.2022 17:13:24
UweD
Schön, dass es nun klappt.
LG UweD
AW: Warum immer noch offen?
28.01.2022 14:45:08
Michael
Hallo,
entschuldigt, ich sehe erst jetzt, wie es hier weiterging. So richtig gelöst scheint mir das Ganze nicht.
Nach dem Problem der schließlich nicht filterbaren Daten werde ich gerne gucken, nur komme ich jetzt nicht dazu. Dass UNION keine Bezüge zu verschiedenen Tabellenblättern verarbeiten kann wusste ich nicht, erscheint aber logisch. Die Blätter ließen sich auch in einer weiteren Schleife durchgehen.
Viele Grüße und ein schönes Wochenende
Michael
AW: Warum immer noch offen?
28.01.2022 15:45:41
Chris
Hallo Michael,
danke für deine Rückmeldung. Am besten wäre es eine Lösung zu finden, die auf dem ursprünglichen Code basiert und eben Eingaben wie 2014 unberücksichtigt lässt.
Der ursprüngliche Code findet sich auch nochmal hier hochgeladen, der Vorteil für mich ist dass es einfach codiert ist, man mehrere Tabellen und Spalten Schritt für Schritt auswählen kann, durch einfaches kopieren und anpassen.
https://www.herber.de/bbs/user/150725.xlsm
Viele Grüße und ebenso schönes Wochenende,
Christian
AW: Umwandlung von Datum
27.01.2022 10:27:33
Datum
Hallo,

Sub in_Datum()
Dim rngC As Range
For Each rngC In Range(Cells(1, 70), Cells(Rows.Count, 70).End(xlUp))
With rngC
If .Text Like "*.*.*" Then
.Value = CLng(CDate(.Value))
.NumberFormat = "DD.MM.YYYY"
End If
End With
Next rngC
End Sub
Gruß
Rudi
AW: Umwandlung von Datum
27.01.2022 12:04:50
Datum
Hallo
noch eine Lösung

Sub RepDate()
Dim RNG As Range, Z
Set RNG = Columns("B:B")
If WorksheetFunction.CountA(RNG) - WorksheetFunction.Count(RNG) > 0 Then
For Each Z In RNG.SpecialCells(xlCellTypeConstants, 2)
Z.Value = CLng(CDate(Z))
Z.NumberFormat = "DD.MM.YYYY"
Next
MsgBox "Datumseinträge repariert", vbInformation, "Verarbeitung erfolgreich!"
Else
MsgBox "Keine falschen Datumseinträge vorhanden", vbInformation, "Verarbeitung beendet!"
End If
End Sub
LG UweD

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige