Makro zum Vergleich von 3 Tabellen um bestimmte Spalten zu löschen

Question

Hallo allerseits,

habe dieses Forum erst eben entdeckt und finde es wirklich super!!

Ich hätte direkt auch ein (für mich) sehr kompliziertes Excel-Problem:

Ich habe 3 Tabellen, von denen ich beispielhaft die relevanten Spalten angegeben habe:

TABELLE 1
Spalte P
49326
49328
49330

TABELLE 2
Spalte B || Spalte D
04005 || 291013
49328 || 15972-60-8
49330 || 51235-04-2

TABELLE 3
Spalte D
291013
15972-60-8
298-04-4

Vereinfacht gesagt, möchte ich ich in Tabelle 1 alle Zeilen NICHT löschen, die in Spalte P eine bestimmte Information haben, welche mit Spalte D von Tabelle 3 identisch ist. Tabelle 2 dient dabei quasi zum übersetzen meines Zahlencodes, da Tabelle 3 leider andere Zahlencodes verwendet als Tabelle 1.
Ich versuchs noch mal anders zu formulieren ;)
WENN in Tabelle 1 in Spalte P eine Zelle identisch ist mit einer Zelle in Spalte B von Tabelle 2
DANN soll die entsprechende Zahl in Spalte D (also die in der gleichen Zeile wie wie mein Wert aus Spalte B) mit Tabelle 3/Spalte D verglichen werden. Kommt der Wert in Tabelle 3 vor, soll die Zeile in Tabelle 1 behalten werden. Alle anderen Zeilen sollen gelöscht werden (außer Zeile 1, da diese Überschriften enthält)

Oje, ich hoffe das war irgendwie zu verstehen :P
Könnte mir hierfür jemand einen passenden Makrocode nennen?
Das wäre echt genial.

Vielen Dank schon mal für jegliche Hilfe!!
Viele Grüße,
Mike

(Bin erst wieder ab Montag zu erreichen, also nicht denken der antwortet ja gar nicht)

Answer 1

Hallo Mike,

versuch mal das folgende Makro. Ich gehe davon aus, dass in der 1. Zeile Überschriften stehen, diese werden daher nicht überprüft.
Probiere das Makro aber erst mal in einer Testdatei aus!

Sub vergleichen()

Dim wbn1, wbn2, wbn3 As String
Dim i, j, k, lz1, lz2, lz3 As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'zu prüfende Tabellenblätter werden festgelegt
wbn1 = "Tabelle 1" 'Tabelle aus der die ggf. Zeilen gelöscht werden
wbn2 = "Tabelle 2" 'Übersetzungstabelle
wbn3 = "Tabelle 3" 'Tabelle mit zu prüfenden Inhalten

'letzte Zeilen werden ermittelt
lz1 = Sheets(wbn1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lz2 = Sheets(wbn2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lz3 = Sheets(wbn3).UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Prüfung beginnt
For i = lz1 To 2 Step -1
For j = 2 To lz2
If Sheets(wbn2).Cells(j, 2) = Sheets(wbn1).Cells(i, 16) Then
For k = 2 To lz3
If Sheets(wbn3).Cells(k, 4) = Sheets(wbn2).Cells(j, 4) Then GoTo Weiter:
Next k
End If
Next j
Sheets(wbn1).Rows(i).Delete Shift:=xlUp
Weiter:
Next i

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Gruß

M.O.

Answer 2

Hi M.O.,
erstmal vielen vielen Dank für deine Antwort!

Leider ist bei dem Code das Problem aufgetreten, dass er meine Tabelle 1 einfach komplett gelöscht hat. Aber ich denke das Makro ist schon mal ein großer Schritt in die richtige Richtung. Hast du eine Idee wo das Problem liegen könnte?

Lieben Dank und viele Grüße,
Mike

Answer 3

Hallo Mike,

dann lade am besten mal eine Beispieltabelle hoch, z.B. hier und poste den Link dann hier.

Gruß

M.O.

Answer 4

Hi M.O.,

alles klar, hier ist der Link:
http://www.file-upload.net/download-4155488/Beispieldatei.xls.html
Danke schon mal!

Viele Grüße
Mike

Answer 5

Hallo,

da deine Werte in Tabelle 2 als Text formatiert sind, gab es das Problem, dass keine Übereinstimmung gefunden wurde.
Hier nun das neue Makro:

Sub vergleichen()

Dim wbn1, wbn2, wbn3 As String
Dim i, j, k, lz1, lz2, lz3, vg As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'zu prüfende Tabellenblätter werden festgelegt
wbn1 = "Tabelle1" 'Tabelle aus der die ggf. Zeilen gelöscht werden
wbn2 = "Tabelle2" 'Übersetzungstabelle
wbn3 = "Tabelle3" 'Tabelle mit zu prüfenden Inhalten

'letzte Zeilen werden ermittelt
lz1 = Sheets(wbn1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lz2 = Sheets(wbn2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
lz3 = Sheets(wbn3).UsedRange.SpecialCells(xlCellTypeLastCell).Row


'Prüfung beginnt
For i = lz1 To 2 Step -1
For j = 2 To lz2
'Wert in Zelle aus Tabelle2 wird in Zahl umgewandelt
vg = Sheets(wbn2).Cells(j, 2) * 1
If Sheets(wbn1).Cells(i, 16).Value = vg Then
For k = 2 To lz3
If Sheets(wbn3).Cells(k, 4).Value = Sheets(wbn2).Cells(j, 4).Value Then GoTo Weiter:
Next k
End If
Next j

'Zeile wird gelöscht
Sheets(wbn1).Rows(i).Delete Shift:=xlUp
Weiter:
Next i

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Probiere es aber trotzdem erst einmal in einer Testdatei aus.

Gruß

M.O.

Answer 6

Hallo M.O.,

entschuldige bitte die sehr späte Antwort. Vielen vielen Dank. Der Code hat wunderbar funtioniert. Das mit dem Formatieren war ein doofer Anfängerfehler von mir gewesen.

Beste Grüße,
Mike

Answer 7

Hallo Mike,

besser spät, wie nie (was hier leider immer wieder vorkommt).

Gruß

M.O.