05.06.2019

2579

VBA gesucht - Excel - ersetze Spalten Inhalt eines Datums ohne Punkt durch Datum mit Punkt

Hallo liebe Gemeinde,

ich bin auf der Suche nach einem VBA Code der es mit ermöglicht die Spalte "A" ab Feld A2 bis unendlich und Spalte "I" ab Feld I2
mit dem Inhalt eines Datums z.B. 31052019 zu einem Datum nach 31.05.2019 (also mit Punkt zu ersetzten).

Leider sind meine VBA Kenntnisse sehr beschränkt. Danke für Eure Unterstützung!

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 459071

Url: https://administrator.de/contentid/459071

Ausgedruckt am: 16.11.2024 um 03:11 Uhr

14 Kommentare

Neuester Kommentar

Moin,

Leider sind meine VBA Kenntnisse sehr beschränkt.

Dann mach's doch mit einer Formel:

=LINKS(A2;2) & "." & TEIL(A2;3;2) & "."  &  RECHTS(A2;4)

lg,
Slainte

Hallo Käpt'n

Sub Datum()
    
    For A = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(A, 1).Value = Left(Cells(A, 1).Value, 2) & "." & Mid(Cells(A, 1).Value, 3, 2) & "." & Right(Cells(A, 1).Value, 4)  
        Cells(A, 9).Value = Left(Cells(A, 9).Value, 2) & "." & Mid(Cells(A, 9).Value, 3, 2) & "." & Right(Cells(A, 9).Value, 4)  
    Next

End Sub

Gruss

Zitat von @Meierjo:

Hallo Käpt'n

Sub Datum()
>     
>     For A = 1 To Cells(Rows.Count, 1).End(xlUp).Row
>         Cells(A, 1).Value = Left(Cells(A, 1).Value, 2) & "." & Mid(Cells(A, 1).Value, 3, 2) & "." & Right(Cells(A, 1).Value, 4)  
>         Cells(A, 9).Value = Left(Cells(A, 9).Value, 2) & "." & Mid(Cells(A, 9).Value, 3, 2) & "." & Right(Cells(A, 9).Value, 4)  
>     Next
> 
> End Sub

Gruss

Cells(A, 1).Value

~~Da hast du aber gleich mehrfach ins Klo gegriffen . Erster Parameter ist die Row, zweiter ist die Column und A muss in Anführungszeichen gesetzt werden wenn du mit Buchstaben statt Zahlen hantierst~~

Meine Version:

Sub MakeDate()
    Dim cell As Range
    With ActiveSheet
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
          If Len(cell.Value) = 8 then
            cell.Value = CDate(Left(cell.Value, 2) & "." & Mid(cell.Value, 3, 2) & "." & Right(cell.Value, 4))  
            cell.NumberFormat = "m/d/yyyy"  
          End if
        Next
        For Each cell In .Range("I2:I" & .Cells(Rows.Count, "I").End(xlUp).Row)  
           If Len(cell.Value) = 8 then
            cell.Value = CDate(Left(cell.Value, 2) & "." & Mid(cell.Value, 3, 2) & "." & Right(cell.Value, 4))  
            cell.NumberFormat = "m/d/yyyy"  
          End if
        Next
    End With
End Sub

Gruß

Hallo

Da hast du aber gleich mehrfach ins Klo gegriffen

. Erster Parameter ist die Row, zweiter ist die Column und A muss in Anführungszeichen gesetzt werden wenn du mit Buchstaben statt Zahlen hantierst

Wieso?? Ich hab's ausprobiert, änderte alle Inhalte in Spalte A und in Spalte I ab, hat funktioniert??
Gruss

Zitat von @Meierjo:
Wieso?? Ich hab's ausprobiert, änderte alle Inhalte in Spalte A und in Spalte I ab, hat funktioniert??

Geht hier aber nicht, voller Fehlermeldungen... wundert mich aber eben nicht, denn wie gesagt, erster Parameter von Cells ist die Row und nicht die Column, wie du hier nachlesen kannst
https://docs.microsoft.com/de-de/office/vba/api/excel.range%28object%29

Moin,

Zitat von @139920:

Zitat von @Meierjo:
Wieso?? Ich hab's ausprobiert, änderte alle Inhalte in Spalte A und in Spalte I ab, hat funktioniert??

Aber genau das macht er doch, in seinem Script!?
In Zeile 3 baut er eine Schleife, wählt "ungeschickterweise" als Variable aber das A. Mit dem A zählt/ geht er dann alle Zeilen durch. Im wweiten Parameter gibt er den SpaltenIndex als Int an (1 für Spalte A bzw. 9 für Spalte I)...

Gruß
em-pie

Ohu, vollkommen übersehen, mea culpa, zu viel des Guten heute.
Wat aber wenn in Spalte A mehr belegte Zeilen hat als Spalte I , dann gibt's trotzdem Kaffeesalat.

Sub DeinCodeDerDieZeilenFüllt
...Fülltext
'wenn Spalten A und I gefüllt sind:  
ThisWorkbook.Worksheets("Tabelle1").Range("A:A").Numberformat = "dd.mm.yyyy"  
ThisWorkbook.Worksheets("Tabelle1").Range("I:I").Numberformat = "dd.mm.yyyy"  
end sub

Falls die Zahlen als Text formatiert sind oder aus sonst einem Grund nicht als Datum erkannt werden:

Sub DeinCodeDerDieZeilenFüllt
...Fülltext
'wenn Spalten A und I gefüllt sind:  
ThisWorkbook.Worksheets("Tabelle1").Range("A:A") = cdate(ThisWorkbook.Worksheets("Tabelle1").Range("A:A"))  
ThisWorkbook.Worksheets("Tabelle1").Range("I:I") = cdate(ThisWorkbook.Worksheets("Tabelle1").Range("I:I"))  
ThisWorkbook.Worksheets("Tabelle1").Range("A:A").Numberformat = "dd.mm.yyyy"  
ThisWorkbook.Worksheets("Tabelle1").Range("I:I").Numberformat = "dd.mm.yyyy"  
end sub

Du hast bereits ein Datum vorliegen, es geht nur noch um das Anzeigeformat. Da muss kein Punkt eingesetzt werden und das Trennen nach dem zweiten Zeichen... puh, man kann sich das auch schwer machen. Wenn Du das mit manuellen Punkten umwandelst, wie das hier einige vorschlagen und Du willst anschließend noch mit einem Datum rechnen, bläst Du nur Deinen Code auf.

Hallo Empie

... wählt "ungeschickterweise" als Variable aber das A...

Wieso ungeschickterweise?
Ich habe mal gelernt, man soll solche Zähler dem Alphabet entsprechend "durchzählen".

Was ist hier falsch, was würdest du ändern?

Gruss

Zitat von @Meierjo:

Hallo Käpt'n

Gruß

super, das funktioniert. Ich danke Euch allen vielmals für die Mühe.

Allerdings habe ich noch einen Sonderfall entdeckt. Manche Zeilen sind mit einem Datum gefüllt ohne führende Null.

z.b. IST: "5122019" ( Soll "05.12.2019")

Wenn ich die Spalte 8 Stellig manuell formatiere wird es zwar anfangs mit 05122019 angezeigt. Das Makro funktioniert aber dennoch für diese Zeilen nicht. 

Hallo

Dann so
Funktioniert aber nur, wenn 8 Stellen vorhanden sind, bei 7 Stellen wird mit ohne die 1. Stelle gerechnet

Sub Datum()
    For A = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Len(Cells(A, 1)) = 8 Then
            Cells(A, 1).Value = Left(Cells(A, 1).Value, 2) & "." & Mid(Cells(A, 1).Value, 3, 2) & "." & Right(Cells(A, 1).Value, 4)  
            ElseIf Len(Cells(A, 1)) = 7 Then
            Cells(A, 1).Value = Left(Cells(A, 1).Value, 1) & "." & Mid(Cells(A, 1).Value, 2, 2) & "." & Right(Cells(A, 1).Value, 4)  
        End If
        
        If Len(Cells(A, 9)) = 8 Then
            Cells(A, 9).Value = Left(Cells(A, 9).Value, 2) & "." & Mid(Cells(A, 9).Value, 3, 2) & "." & Right(Cells(A, 9).Value, 4)  
            ElseIf Len(Cells(A, 9)) = 7 Then
            Cells(A, 9).Value = Left(Cells(A, 9).Value, 1) & "." & Mid(Cells(A, 9).Value, 2, 2) & "." & Right(Cells(A, 9).Value, 4)  
        End If
    Next
End Sub

Gruss

Ich würd's zuverlässiger so machen dann sind ungültige Werte auch passé ...

Dim regex As Object

Sub ProcessRanges()
    Dim cell As Range, result As String
    Set regex = CreateObject("vbscript.regexp")  
    regex.Pattern = "^(0?[1-9]|[1-2][0-9]|3[0-1])(0[1-9]|1[0-2])(19[0-9][0-9]|[2-9]\d{3})$"  
    
    With ActiveSheet
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row & "," & "I2:I" & .Cells(Rows.Count, "I").End(xlUp).Row)  
            FormatDate cell
        Next
    End With
    Set regex = Nothing
End Sub

Sub FormatDate(rngCell As Range)
    If regex.Test(rngCell.Text) Then
        result = regex.Replace(rngCell.Text, "$1.$2.$3")  
        rngCell.NumberFormatLocal = "TT.MM.JJJJ"  
        rngCell.Value = CDate(result)
    End If
End Sub

Perfekt, es funktioniert!!!!!!!

Kann man das gleiche Vorgehen noch um Spalte U ab U2 bis unendlich erweitern?

Zitat von @CaptnHowdy:

Perfekt, es funktioniert!!!!!!!

Kann man das gleiche Vorgehen noch um Spalte U ab U2 bis unendlich erweitern?

Klar.
Zeile 9 ersetzen durch

For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row & "," & "I2:I" & .Cells(Rows.Count, "I").End(xlUp).Row & "," & "U2:U" & .Cells(Rows.Count, "U").End(xlUp).Row)  

Usw. , Schema sollte jetzt klar sein.