0

我正在寻找一种快速删除特定列中的重复项但仅在过滤范围内的方法。所以，基本上我希望它只删除可见的重复值，但留下“未过滤和隐藏”的其余部分。

我有这段代码，不知道如何改变它：

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

能否请你帮忙？有没有简单的方法来编辑现有代码来做到这一点？

*例如：

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

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

4

3 回答 3

2

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

对于将 A、B 和 C 列作为大陆、国家和城市的示例，以下内容如何：

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

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

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

这是示例的屏幕截图。原始列表在右侧，结果列表在左侧（在 AC 列中）。注意“伦敦”和“伯明翰”：

在此处输入图像描述

于 2017-01-24T13:51:33.617 回答
0

也许你需要一个自定义的 VBA dup-remover。尝试这个：

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
于 2017-01-24T18:06:42.433 回答
0

您可能会追求对象的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
于 2017-01-24T14:38:57.967 回答