Excel VBA - 删除重复项答案

【问题标题】：Excel VBA - Removing duplicatesExcel VBA - 删除重复项
【发布时间】：2016-09-24 14:59:51
【问题描述】：

我尝试对工作簿中的工作表进行排序。在宏对我的表进行排序后，它应该根据 A 列删除所有重复项。

但每次我使用宏时，都会出现以下错误：

Sub SortAndRemoveDUBS()

Dim Rng As Range
Dim LastRow As Long
Dim i As Long

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

Set Rng = Range("A4:P" & LastRow)

With Rng
    .Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
End With

Dim arr() As Variant
Dim cnt As Long

cnt = 0

For i = LastRow To 2 Step -1
    If WorksheetFunction.CountIf(Range(Cells(2, "A"), Cells(i, "A")), Cells(i, "A")) > 1 Then
  ReDim Preserve arr(cnt)
  arr(cnt) = i
  cnt = cnt + 1
End If
Next i

If Len(Join(arr)) > 0 Then ActiveSheet.Range("A" & Join(arr, ",A")).EntireRow.Delete

Application.ScreenUpdating = True

End Sub

这一行被突出显示：

ActiveSheet.Range("A" & Join(arr, ",A")).EntireRow.Delete

有人知道问题出在哪里吗？

【问题讨论】：

不是答案，但另一种方法可能是删除 for 循环中的行？
我认为这会减慢宏的速度？我之前有另一个版本，但是对于那么多行来说太慢了。
是的，如果您找不到答案，这可能是您的最后选择。我对join函数不熟悉，所以这里帮不上忙。
也许您可以在 for 循环中循环 arr 元素并创建一个范围或选择它们然后立即删除。
您是否尝试使用此代码，activesheet.range("A2", "A4", "A6").entirerow.delete ？

标签： vba excel excel-2010

【解决方案1】：

使用RemoveDuplicates()

并且，由于您从“A”列中删除了所有重复项，因此您可以按“A”列或“P”列排序：我假设您需要后者

Sub SortAndRemoveDUBS()
    With Worksheets("MyDataSheet") '<--| change "MyDataSheet" to your actual worksheet name
        With Range("A4:P" & .Cells(.Rows.Count, "B").End(xlUp).Row)
            .RemoveDuplicates Columns:=Array(1)
            .Sort Key1:=Range("P4"), order1:=xlDescending, _
                Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
                Orientation:=xlTopToBottom
        End With
    End With
End Sub

【讨论】：

@ShaiRado，Excel 的一个非常好的功能。谢谢
删除重复项...但由于某种原因，排序无法按预期工作。我对列 P 进行排序，因为其中包含日期。他应该保留最新/未来的日期|||现在它可以工作了 - 我把 .RemoveDuplicates 放在了底部。 |||

【解决方案2】：

如果您想删除除第一个之外的所有重复项，那么此代码将在 2007 年及以后工作：

Sub SortAndRemoveDUBS()

    Dim Rng As Range
    Dim LastRow As Long

    Application.ScreenUpdating = False

    LastRow = Cells(Rows.Count, "B").End(xlUp).Row

    Set Rng = Range("A4:P" & LastRow)

    With Rng
        .Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
            Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom
    End With

    Rng.RemoveDuplicates Columns:=1, Header:=xlYes

    Application.ScreenUpdating = True

End Sub

编辑： 如果您想删除所有重复项，则此代码将完成这项工作：

Sub SortAndRemoveDUBS()

    Dim Rng As Range
    Dim LastRow As Long
    Dim i As Long
    Dim RngToDelete As Range

    Application.ScreenUpdating = False

    LastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row

    Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("A4:P" & LastRow)

    With Rng
        .Sort Key1:=Range("A4"), Order1:=xlAscending, key2:=Range("P4"), order2:=xlDescending, _
            Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom

        For i = LastRow To 4 Step -1
            If WorksheetFunction.CountIf(.Resize(, 1), .Cells(i - 3, 1)) > 1 Then
                If RngToDelete Is Nothing Then
                    Set RngToDelete = .Cells(i - 3, 1).EntireRow
                Else
                    Set RngToDelete = Union(RngToDelete, .Cells(i - 3, 1).EntireRow)
                End If
            End If
        Next i
    End With

    If Not RngToDelete Is Nothing Then
        RngToDelete.Delete
    End If

    Application.ScreenUpdating = True

End Sub

【讨论】：

不起作用...“排序参考无效。[...]”。

【解决方案3】：

尝试使用 Application.WorksheetFunction.Match 方法

例子

Option Explicit
Sub Function_Match()
    Dim vRow As Variant
    Dim i As Long, LastRow As Long

    LastRow = WorksheetFunction.CountA(Columns(1))

    For i = LastRow To 2 Step -1
        vRow = Application.Match(Cells(i, 1).Value, Range(Cells(1, 1), Cells(i - 1, 1)), 0)
        If Not IsError(vRow) Then
            Rows(vRow).Delete
        End If
    Next

End Sub

【讨论】：