AW: Doppelte Nummern aus zwei Mappen
15.11.2023 15:17:41
Piet
hallo
ich sende dir mal ein "Bananen Makro". Es ist noch unreif, d.h., du musst einige Namen durch deine Tabellennamen ersetzten.
Set Vgl = Workbooks("Vergleichsdatei").Worksheets("XXX") '** - da musst du deine externe Mappe und die Tabelle angeben.
With ThisWorkbook.Worksheets("XXX") - da musst du deinen Tabellen Namen der Quell Datei angeben. Wo das Makro drin ist!
Set Asw = ThisWorkbook.Worksheets("ASW") - erwartet eine neu erstellte Tabelle Namens "ASW" zum doppelte auflisten
Das Makro kannst du in beide Tabellen kopieren. Es vergleicht alle Daten mit der anderen Mappe, und listet doppelte auf.
Voraussetzung ist, das alle Mappen und Tabellen Namen korrekt angegeben sind. Dann sollte es problemlos klappen.
mfg Piet
Option Explicit '16.11.2023 Piet für Herber Forum
Dim AC As Range, lz1 As Long
Const Farbe = 36 'gelb (schwach)
'zwei Mappen Kunden Nummer vergleichen
Sub KundenNummern_vergleichen()
Dim Asw As Worksheet, n, ze As Long 'Auswertungs Tabelle
Dim Vgl As Worksheet, rFind As Range 'Externe Vergleich Mappe
Set Vgl = Workbooks("Vergleichsdatei").Worksheets("XXX") '**
Set Asw = ThisWorkbook.Worksheets("ASW") '** Tabelle einfügen
'Auswertungs Tabelle löschen
Asw.UsedRange.Offset(1, 0).Clear
ze = 2 '1. Zeile zum auflisten
With ThisWorkbook.Worksheets("XXX")
'Innenfarbe in beiden Mappen löschen
.Columns(1).Interior.ColorIndex = xlNone
Vgl.Columns(1).Interior.ColorIndex = xlNone
'LastZell in Quell Datei suchen
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
'Alle Kunden Nr. nach vergleich durchsuchen
For Each AC In .Range("A2:A" & lz1)
Set rFind = Vgl.Columns(1).Find(What:=AC, After:=[a1], LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRcolumns, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
AC.Interior.ColorIndex = Farbe
rFind.Interior.ColorIndex = Farbe
Asw.Cells(ze, 1) = AC.Value
Asw.Cells(ze, 2) = AC.Row
Asw.Cells(ze, 3) = rFind.Row
ze = ze + 1
End If
Next AC
End With
End Sub