Zellen bereinigen

Hallo zusammen,

ich lese aus mehreren Dateien über einen vba Code einzelne Zellen aus diesen Dateien aus.
Primär sind es Datumsangaben, die dann in meine neue Datei eingefügt werden. Jedoch habe ich das Problem, dass die Daten sehr unterschiedlich eingegeben werden.
Hier ein paar Beispiele:
01.06.2020 - 13.09.2020
Mai / Juni 2018
09/2023
29.08.21/ 14.02.22
01.-05.2013
22.08.22 / 22.09.22
Febr.- Dez. 21
Jan+Febr 19
12/24-02/25
IST 12/22 + 04/23
Plan 09/ 2024
bis Ende 2023
15.10.2022
Habt ihr Ideen, wie man es hinbekommt dass nur ein Datum (egal ob das frühere oder hintere) und sonst nichts (entfernen von Buchstaben) in die Zellen übernommen wird?

Zwar formatiere ich die Zellen in ein Datumsformat, jedoch bekommt excel es nicht hin dann nur ein Datum zu finden.

Vielen Dank im Voraus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Einlesen() Dim Pfad As String, Ext As String, Datei As String Dim TB As Worksheet, Sp As Integer, LR As Long Dim intI As Integer Set TB = ActiveSheet Sp = 1 'Daten in Spalte A beginnend Ext = "*.xlsm" Pfad = "C:\Lola\Desktop\Datensätze\" With TB Datei = Dir(Pfad & Ext) Do While Len(Datei) > 0 LR = .Cells(.Rows.Count, Sp).End(xlUp).Row + 1 'erste freie Zeile Spalte 'Hier werden die Datumsangaben eingefügt.......................................................... .Cells(LR, Sp).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Bemerkungen'!R7C3" .Cells(LR, Sp + 1).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Bemerkungen'!R7C4" .Cells(LR, Sp + 18) = Datei Datei = Dir() 'nächste Datei Loop intI = 2 Do While TB.Cells(intI, 1).Value > "" .Cells(intI, 1).NumberFormat = "mmmm yyyy" .Cells(intI, 2).NumberFormat = "mmmm yyyy" intI = intI + 1 Loop End With End Sub Sub Einlesen() Dim Pfad As String, Ext As String, Datei As String Dim TB As Worksheet, Sp As Integer, LR As Long Dim intI As Integer Set TB = ActiveSheet Sp = 1 'Daten in Spalte A beginnend Ext = "*.xlsm" Pfad = "C:\Lola\Desktop\Datensätze\" With TB Datei = Dir(Pfad & Ext) Do While Len(Datei) > 0 LR = .Cells(.Rows.Count, Sp).End(xlUp).Row + 1 'erste freie Zeile Spalte 'Hier werden die Datumsangaben eingefügt.......................................................... .Cells(LR, Sp).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Bemerkungen'!R7C3" .Cells(LR, Sp + 1).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Bemerkungen'!R7C4" .Cells(LR, Sp + 18) = Datei Datei = Dir() 'nächste Datei Loop intI = 2 Do While TB.Cells(intI, 1).Value > "" .Cells(intI, 1).NumberFormat = "mmmm yyyy" .Cells(intI, 2).NumberFormat = "mmmm yyyy" intI = intI + 1 Loop End With End Sub

Hallo

es scheint, als ob der Code mal von mir stammt. :-)

Ich nehme den hinteren Teil, wenn mehrere Daten angegeben sind, da dort meist die Jahreszahl enthalten ist.
Fehlt der Tag, setze ich den 01. ein (macht Excel manchmal auch automatisch)
Bei Ende.. nehme ich 31.12.



Sub Einlesen()

 

    Dim Pfad As String, Ext As String, Datei As String

    Dim TB As Worksheet, Sp As Integer, LR As Long



 

    Set TB = ActiveSheet

    Sp = 1 'Daten in Spalte A beginnend

   

    Ext = "*.xlsm"

    Pfad = "C:\Lola\Desktop\Datensätze\"

    'Pfad = "D:\Excel\temp\Test\"

   

    With TB

        .Columns(Sp).Resize(, 2).NumberFormat = "mmmm yyyy"

        Datei = Dir(Pfad & Ext)

        Do While Len(Datei) > 0

       

            LR = .Cells(.Rows.Count, Sp).End(xlUp).Row + 1 'erste freie Zeile Spalte

           

                'Hier werden die Datumsangaben eingefügt..........................................................

                With .Cells(LR, Sp)

                    .FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Bemerkungen'!R7C3"

                    If .Value > "" Then .Value = Datum_normieren(.Value)

                End With

                

                With .Cells(LR, Sp + 1)

                    .FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Bemerkungen'!R7C4"

                    If .Value > "" Then .Value = Datum_normieren(.Value)

                End With

                

                .Cells(LR, Sp + 18) = Datei

           

            Datei = Dir() 'nächste Datei

        Loop

       

    End With

   

End Sub





Private Function Datum_normieren(TMP As String)

    Dim TT As String

    TT = TMP

    Select Case True

        Case IsDate(TMP)

            'mache nix

        Case InStr(TMP, "-")

            TMP = Trim(Mid(TMP, InStr(TMP, "-") + 1))

        

        Case InStr(TMP, "bis Ende")

            TMP = "31.12." & Trim(Replace(TMP, "bis Ende", ""))

            

        Case InStr(TMP, "Plan")

            TMP = "01." & Trim(Replace(TMP, "Plan", ""))

            

        Case InStr(TMP, "+")

            TMP = Trim(Mid(TMP, InStr(TMP, "+") + 1))

            

        Case InStr(TMP, "/")

            TMP = Trim(Mid(TMP, InStr(TMP, "/") + 1))

    

    End Select

    

    If Not IsNumeric(Right(TMP, 4)) Then

        'Jahreszahl 2stellig

        TMP = "01." & TMP

    End If

    

    If Not IsDate(TMP) Then

        If Len(TMP) - Len(Replace(TMP, "/", "")) > 2 Then 'nur ein /

            TMP = "01." & TMP

        End If

        

        If Len(TMP) - Len(Replace(TMP, ".", "")) > 2 Then 'nur ein .

            TMP = "01." & TMP

        End If

        

        If Not IsNumeric(Left(TMP, 1)) Then 'keine Zahl vorne

            TMP = "01." & TMP

        End If

    End If

    On Error GoTo Fehler

    Datum_normieren = CDate(TMP)

    Exit Function

Fehler:

    Datum_normieren = TT & ": ist kein Datum"

End Function

LG UweD

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen bereinigen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread