删除重复值

Question

我正在尝试删除基于 B 列的所有重复行，只保留唯一的行。

它将留下重复的条目之一。我尝试使用> 1 和 = 2。

Sub test1()
Dim fName As String, fPath As String, wb As Workbook, sh As Worksheet, i As Long, lCopyLastRow As Long, lDestLastRow As Long
Set sh = ActiveSheet
fPath = ThisWorkbook.Path & ""
fName = Dir(fPath & "*.xls*")

Do
If fName <> ThisWorkbook.Name Then

Set wb = Workbooks.Open(fPath & fName)
lCopyLastRow = wb.Sheets(1).Cells(wb.Sheets(1).Rows.Count, "A").End(xlUp).Row
lDestLastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1).Row
wb.Sheets(1).Range("A2:AA1000" & lCopyLastRow).Copy sh.Range("B" & lDestLastRow)
sh.Range("A1") = "Source"

With sh
.Range(.Cells(Rows.Count, 1).End(xlUp)(2), .Cells(Rows.Count, 2).End(xlUp).Offset(, -1)) = fName
End With
wb.Close

End If

Set wb = Nothing
fName = Dir

Loop Until fName = ""

For i = sh.UsedRange.Rows.Count To 2 Step -1
If Application.CountIf(sh.Range("B:B"), sh.Cells(i, 2).Value) > 1 Then Rows(i).Delete
Next
End Sub

Answer 1

代码的问题在于，您countIf剩余的行 - 如果您已经删除了"其他"重复项，则第一个是当时剩余列表中的唯一值。

因此，您必须在删除之前计算发生次数。

Sub removeNonUniqueRows()
Dim arrCountOccurences As Variant
ReDim arrCountOccurences(2 To sh.UsedRange.Rows.Count)
Dim i As Long
For i = 2 To sh.UsedRange.Rows.Count
arrCountOccurences(i) = Application.CountIf(sh.Range("B:B"), sh.Cells(i, 2).Value)
Next
For i = sh.UsedRange.Rows.Count To 2 Step -1
If arrCountOccurences(i) > 1 Then sh.Rows(i).Delete
Next
End Sub