VBA Vergleichen und Duplikate löschen

Hallo zusammen,
leider habe ich wieder mal ein Problem aber diesmal auch keine Idee.
Habe auch mal ein Code aus Google kopiert aber funktioniert nicht.
Ich habe 2 Tabellen in eine Exceldatei.
Dim WB1 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Set WB1 = ThisWorkbook
Set WS1 = WB1.Worksheets("Master_Verpackungsoptimierung")
Set WS2 = WB1.Worksheets("Verpackungsoptimierung")
Ich möchte gern das Spalte 1 von der WS1 und Spalte 1 von WS2 verglichen wird und die Zeilen der Duplikaten aus WS2 gelöscht werden.
Hier mal den Code aus den Internet der nicht funktioniert.
WS2 ist als Tabellenformat angelegt und WS1 nicht.

Sub Schaltfläche5_Klicken()
Dim lngRow As Long
Dim WB1 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Set WB1 = ThisWorkbook
Set WS1 = WB1.Worksheets("Master_Verpackungsoptimierung")
Set WS2 = WB1.Worksheets("Verpackungsoptimierung")
lngRow = WS2.Cells(Rows.Count, 1).End(xlUp).Row
With WS1.UsedRange
With .Columns(.Columns.Count).Offset(2, 1)
.FormulaR1C1 = "=If(Countif(Tabelle1!R1C1:R" & lngRow & "C1,RC1)=0,"""",TRUE)"
.EntireRow.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
.ClearContents
End With
End With
End Sub

Vielleicht hat jemand ja eine Idee, vielen Dank im Voraus.
lg René

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Schaltfläche5_Klicken() Dim WB1 As Workbook Dim WS1 As Worksheet, WS2 As Worksheet Dim strText As String Dim CompareRange As Variant, x As Variant, y As Variant Set WB1 = ThisWorkbook Set WS1 = WB1.Worksheets("Verpackungsoptimierung") Set WS2 = WB1.Worksheets("Master_Verpackungsoptimierung") WB1.RefreshAll 'Aktualisierung des Optimierungstool (Herunterladen von der DB) Set CompareRange = WS2.Range("A3:A4000") ' Jede Zelle in der Auswahl durchlaufen und sie mit jeder Zelle ' in CompareRange vergleichen. For Each x In Selection For Each y In CompareRange If x = y Then x.Offset(0, 1) = x Next y Next x End Sub

Sub Schaltfläche5_Klicken() Dim WB1 As Workbook Dim WS1 As Worksheet, WS2 As Worksheet Dim CompareRange As Range Dim y As Long Dim x As Range Dim z As Long Set WB1 = ThisWorkbook z = 3 Set WS1 = WB1.Worksheets("Master_Verpackungsoptimierung") Set WS2 = WB1.Worksheets("Verpackungsoptimierung") WB1.RefreshAll 'Aktualisierung des Optimierungstool (Herunterladen von der DB) y = z Set CompareRange = WS1.Range("A3:A4000") ' Jede Zelle in der Auswahl durchlaufen und sie mit jeder Zelle ' in CompareRange vergleichen. For Each x In CompareRange Do If WS2.Cells(y, 1) = "" Then Exit Do If WS2.Cells(y, 1) = x.Value Then WS2.Rows(y).EntireRow.Delete Else y = y + 1 End If Loop y = 3 Next x End Sub

Sub Schaltfläche5_Klicken() Dim WB1 As Workbook Dim WS1 As Worksheet, WS2 As Worksheet Dim iZeile As Long Set WB1 = ThisWorkbook Set WS1 = WB1.Worksheets("Verpackungsoptimierung") Set WS2 = WB1.Worksheets("Master_Verpackungsoptimierung") Application.ScreenUpdating = False WB1.RefreshAll 'Aktualisierung des Optimierungstool (Herunterladen von der DB) For iZeile = WS2.Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1 If WorksheetFunction.CountIf(WS1.Columns(1), WS2.Cells(iZeile, 1)) > 0 Then _ WS2.Rows(iZeile).EntireRow.Delete Next iZeile End Sub

Beliebteste Forumthreads (12 Monate)

VBA Vergleichen und Duplikate löschen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread