VBA从2列中删除重复值

Question

我有一个包含3列的列表

我想删除没有移位的任何重复值，重复的值可以是第一列和第二列。

我该怎么做？

我已经尝试了一些东西，但它没有工作

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

尝试这两个列是B和C的情况。它循环遍历所有数据并使用工作表函数COUNTIF检查每个值是否出现多个并清除单元格的内容如果计数超过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