检查所有列后删除重复的行

我已经写下了下面的macros来检查所有列后删除重复的行。 我认为这是工作正常，基于逻辑，但输出不正确，应该显示的一些行被删除。 任何人都可以帮助我吗？

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

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

要删除重复项，只需点击Data Ribbon> Data Tools中的“删除重复项”button即可。
以下是演示：
我在工作表中有这样的数据：

我想在A栏有独特的数据
点击“删除重复”button，出现下面的屏幕，我取消选中columnB

单击确定button，并有一个通知框告诉我，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