Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
300to304
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
300to304
300to304
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datenabgleich

Datenabgleich
28.08.2003 14:57:55
Magnus
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenabgleich
31.08.2003 16:10:56
Erich M.
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige