Excel VBA - 删除重复项

Question

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

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

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

此行突出显示：

public class TestClass {

    public TestClass(Long param1, boolean param2, Long param3) {
        System.out.println(param1);
        System.out.println(param2);
        System.out.println(param3);
    }

    public static void main(String[] args) {
        new TestClass(1L, false,2L);
    }
}

有人看到问题是什么吗？

Answer 1

如果要删除除第一个之外的所有重复项，则此代码将在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

Answer 2

使用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

Answer 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