VBA Löschen doppelte Werte aus 2 Spalten

Question

Ich habe eine Liste mit drei Spalten

ich einen doppelten Wert ohne Verschiebung löschen möchten, können die duplizierten Werte sowohl in der ersten Spalte und auf die zweite.

Wie kann ich das tun?

Ich habe etwas versucht, aber es nicht diese

Sub RemoveDuplicates() 
Dim rng As Range 
Dim x As Long 
Dim lRow As Long 
Dim i As Integer 

Columns("B:C").Select 
    Range("C1").Activate 
    Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
    Selection.Replace What:="0", Replacement:="0", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
i = 1 
x = 1 
Do While Cells(i, 1).Value <> "" 
    Cells(i, 4) = "=CONCATENATE(0,RC[-2])" 
    i = i + 1 
Loop 
Do While Cells(x, 1).Value <> "" 
    Cells(x, 5) = "=CONCATENATE(0,RC[-2])" 
    x = x + 1 
Loop 
    Columns("D:E").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Range("B1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    Columns("D:E").ClearContents 
Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 

With ThisWorkbook.Sheets(1) 
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
    Set rng = ThisWorkbook.Sheets(1).Range("B2:C" & lRow) 
End With 

For x = rng.Cells.Count To 1 Step -1 
    If WorksheetFunction.CountIf(rng, rng(x)) > 1 Then 
     rng(x).ClearContents 
    End If 
Next x 

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub 

Answer 1

Versuchen funktionierte, wo Ihre zwei Spalten B und C. Es Schleifen durch alle Daten und verwendet die Tabellenfunktion COUNTIF, wenn es zu prüfen, den Inhalt der Zelle mehr als ein Auftreten von jedem Wert und löscht, wenn es eine Zählung von mehr als 1:

Sub RemoveDuplicates() 

Dim rng As Range 
Dim x as Long 
Dim lRow as Long 

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 

With Thisworkbook.Sheets("SheetName") 
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
    Set rng = .Range("B2:C" & lRow) 
End With 

For x = rng.Cells.Count To 1 Step -1 
    If WorksheetFunction.CountIf(rng, rng(x)) > 1 Then 
     rng(x).ClearContents 
    End If 
Next x 

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub