Microsoft Excel

Herbers Excel/VBA-Archiv

Datenabgleich

    Betrifft: Datenabgleich von: Magnus
    Geschrieben am: 28.08.2003 14:57:55

    Hallo Forum, ich benötige Eure Hilfe für folgendes Problem:

    Ich möchte zwei Adressdatensätze A und B miteinander vergleichen.
    Der Spaltenaufbau der Daten sieht in etwa so aus:
    Unternehmen/Strasse/Nr./PLZ/Ort usw...

    Verglichen werden soll nur das Unternehmen (Spalte A) und als Ergebnis werden einfache und doppelte Einträge auf zwei neuen Datenblättern ausgegeben. Folgendes Makro funktioniert prima, aber nur für Einträge in Spalte A. Steht etwas in den Spalten B,C,D ... bekomme ich eine Fehlermeldung.

    Wie muss ich das Makro anpassen (im Archiv gefunden), damit im Ergebnis alle Spalteneinträge in die neuen Datenblätter übernommen werden?

    Danke für Eure Hilfe, Magnus.

    Option Explicit

    Sub Vergleich()
    Dim S1 As Worksheet, S2 As Worksheet, Einfach As Worksheet, Doppelt As Worksheet
    Dim C As Range, SB As Variant, Z As Long, lZ As Long
    Set S1 = Sheets("A")
    Set S2 = Sheets("B")
    Set Einfach = Sheets("einfach")
    Set Doppelt = Sheets("doppelt")
    Einfach.Columns(1).ClearContents
    With Einfach
    .[a1] = "einfach"
    .[a1].Font.Bold = True
    End With
    Doppelt.Columns(1).ClearContents
    With Doppelt
    .[a1] = "doppelt"
    .[a1].Font.Bold = True
    End With
    Application.ScreenUpdating = False
    S1.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=S1.Columns(2), Unique:=True
    S2.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=S2.Columns(2), Unique:=True
    lZ = S1.[b65536].End(xlUp).Row
    For Z = 2 To lZ
    SB = S1.Cells(Z, 2)
    With S2.Columns(2)
    Set C = .Find(SB, LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByColumns)
    If Not C Is Nothing Then
    Doppelt.[a65536].End(xlUp).Offset(1, 0) = SB
    Else
    Einfach.[a65536].End(xlUp).Offset(1, 0) = SB
    End If
    End With
    Next
    ENDE:
    S1.Columns(2).ClearContents
    S2.Columns(2).ClearContents
    Application.ScreenUpdating = True
    Set C = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Set Einfach = Nothing
    Set Doppelt = Nothing
    End Sub
    

      


    Betrifft: AW: Datenabgleich von: Erich M.
    Geschrieben am: 31.08.2003 16:10:56

    Hallo Magnus,

    schau mal in diese Datei, vielleicht hilft Dir einer der Vergleiche
    weiter. Mich würde die Lösung aber auch interessieren:
    https://www.herber.de/bbs/user/798.zip

    mfg
    Erich