检查所有列后删除重复行

Question

我编写了下面的宏来在检查所有列后删除重复的行。根据逻辑，我认为它工作正常，但输出不正确，一些应该显示的行被删除了。任何人都可以帮我吗？

在这个宏运行之前，我有另一个宏来按几列对数据进行排序，以确保相似的行被分组在一起，所以也许宏可以考虑到这一点，并且只检查它上面的行而不是检查所有行？非常感谢任何帮助！

Sub Delete_Repeated_Rows()
Dim Rng As Range
Dim ColumnCounter As Integer

Set Rng = ActiveSheet.UsedRange.Rows

'Using ColumnCounter to hold total number of cells that match. If all of them match, delete row'

 For r = Rng.Rows.Count To 1 Step -1
    ColumnCounter = 0
    For Col = Rng.Columns.Count To 1 Step -1 'Loop through columns and find matches'
        If Application.WorksheetFunction.CountIf(Rng.Columns(Col), Rng.Cells(r, Col)) > 1 Then
            ColumnCounter = ColumnCounter + 1
        End If
    Next Col

    If ColumnCounter = Rng.Columns.Count Then
        Rng.Rows(r).EntireRow.Delete
    End If
Next r
End Sub

Answer 1

要删除重复项，您只需单击“数据功能区”>“数据工具”中的 "Remove duplicate" 按钮即可。
以下是演示：
我在工作表中有这样的数据：

我想在 A 列有唯一数据
单击 "Remove duplicate" 按钮并出现以下屏幕，我取消选中 columnB

单击“确定”按钮后会出现一个通知框，告诉我删除了 2 个重复值并找到了 5 个唯一值，如下图所示：

最终结果如下：

Answer 2

使用内置的 RemoveDuplicates 命令。这将比遍历行快得多。框中唯一的技巧是为列参数传递数组。

Sub DeDupe()
    Dim intArray As Variant, i As Integer
    Dim rng As Range
    Set rng = ActiveSheet.UsedRange.Rows
    With rng
        ReDim intArray(0 To .Columns.Count - 1)
        For i = 0 To UBound(intArray)
            intArray(i) = i + 1
        Next i
        .RemoveDuplicates Columns:=(intArray), Header:=xlYes
    End With
End Sub

检查所有列后删除重复行

Removing duplicate rows after checking all columns

excel

vba

duplicates