Question

我正在寻找一种快速删除特定列中重复项的方法，但只能在过滤范围内删除。所以，基本上我希望它只删除可见的重复值，但剩下的就是＆＃34;未过滤和隐藏＆＃34;。

我有这段代码，并且不知道如何更改它：

ActiveSheet.Range("A:ZZ").RemoveDuplicates Columns:=Array(3), Header:=xlYes

你可以帮忙吗？是否有任何简单的方法来编辑现有代码来执行此操作？

*例如：

A栏=大陆
B列=国家
C栏=城市

如果我按照印度过滤国家（col B），我会看到多个城市重复多次（col C）。我想删除重复项，只查看每个城市中的一个。但是，我不希望其他国家/地区删除重复项。*

Answer 1

您可以通过在RemoveDuplicates参数中指定所有3来删除所有Continent-Country-City组合的重复项，而不过滤。这并不能完全回答您的问题，但它可能是您需要的解决方案，只需少一步。

对于将A，B和C列作为“大陆”，“国家/地区”和“城市”的示例，请执行以下操作：

ActiveSheet.Range("A:C").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

注意Array部分指定要评估的范围中的第1,2和3列，它将查找所有3列中的重复项（而不是现有代码中的第3列）。

我建议在数据副本上对此进行测试，因为宏不允许“撤消”。

以下是示例的屏幕截图。原始列表位于右侧，结果列表位于左侧（在A-C列中）。注意“伦敦”和“伯明翰”：

Answer 2

您可能在SpecialCells(xlCellTypeVisible)对象的Range属性之后。所以你的代码可能是：

ActiveSheet.Range("A:ZZ").SpecialCells(xlCellTypeVisible).RemoveDuplicates Columns:=Array(3), Header:=xlYes

但是，一旦删除过滤器，它确实会留下空行。我所知道的唯一另一种方式（它不会留空行）是使用您自己的重复查找例程删除重复项。 SpecialCells属性仍可用于仅检查筛选数据。像这样：

Dim uniques As Collection
Dim cell As Range, del As Range
Dim exists As Boolean
Dim key As String

Set uniques = New Collection
For Each cell In ActiveSheet.Range("A:ZZ").Columns(3).SpecialCells(xlCellTypeVisible).Cells
    key = CStr(cell.Value2)
    exists = False
    On Error Resume Next
    exists = uniques(key)
    On Error GoTo 0
    If Not exists Then
        uniques.Add True, key
    Else
        If del Is Nothing Then
            Set del = cell
        Else
            Set del = Union(del, cell)
        End If
    End If
Next
If Not del Is Nothing Then
    del.EntireRow.Delete
End If

Answer 3

也许你需要一个自定义VBA重复删除器。试试这个：

Sub RemoveVisibleDupes(r As Range, comparedCols)
    Dim i As Long, j As Long, lastR As Long
    i = r.Row: lastR = r.Row + r.Rows.count - 1
    Do While i < lastR
        For j = lastR To i + 1 Step -1
            If Not (r.Rows(i).Hidden Or r.Rows(j).Hidden) And areDup(r.Rows(i), r.Rows(j), comparedCols) Then
                r.Rows(j).Delete
                lastR = lastR - 1
            End If
        Next
    i = i + 1
    Loop
End Sub

Function areDup(row1 As Range, row2 As Range, comparedCols) As Boolean
    Dim col
    For Each col In comparedCols
        If row1.Cells(col).Value <> row2.Cells(col).Value Then Exit Function
    Next
    areDup = True
End Function

<强>测试

Sub TestIt()
    On Error GoTo Finish
    Application.DisplayAlerts = False: Application.EnableEvents = False: Application.ScreenUpdating = False

    ' call our custom dup-remover on filtered columns A:C with comparing columns 1 and 3
    RemoveVisibleDupes Sheet2.Range("A1:C" & Sheet2.Cells(Sheet2.Rows.count, 1).End(xlUp).Row), Array(1, 3)
    ' To use it with one column only, say 3, replace Array(1, 3) with array(3)

Finish:
    Application.DisplayAlerts = True: Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

VBA - 删除FILTERED列

3 个答案: