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

Zellen bereinigen

Forumthread: Zellen bereinigen

Zellen bereinigen
14.12.2023 08:14:42
Lola
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
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Zellen bereinigen
14.12.2023 08:21:09
UweD
Hallo

Zeig doch mal den Code vom Einlesen. Da würde ich das direkt mit einbauen.

LG UweD
AW: Zellen bereinigen
14.12.2023 08:44:15
Lola
Hallo Uwe,

anbei mein genutzter Code. Ich hoffe die Formatierung wurde mit übernommen. 





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
Anzeige
AW: Zellen bereinigen
14.12.2023 12:09:44
UweD
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
Anzeige
AW: Zellen bereinigen
15.12.2023 12:15:52
Lola
Hallo Uwe,

kann sein dass der Code von dir war, da ich bereits schon einmal Hilfe brauchte! :)

Der überarbeitete Code funktioniert soweit super, danke dafür!
Es tritt jedoch nur ein Problem auf und zwar wird bei den zwei folgenden Beispielen der Januar als Monat gewählt und nicht der tatsächliche Monat.
IST 07/23 ->Januar 2023
IST 06/ 2022 ->Januar 2022
Ich habe schon probiert das Problem allein zu lösen, habe es allerdings nicht geschafft ohne mir den Rest zu zerschießen.
Hast du hier ein Lösung für?

Gruß
Anzeige
;

Beliebteste Forumthreads (12 Monate)

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