基于多列删除重复行

Question

从基础上讲，我找到了以下公式，这是完美的，除了它仅过滤基于A列重复，而我只希望删除行A，B和C，而所有的行都被重复。

Sub removeDupes()
    Dim i As Long
    Dim ws As Worksheet

    Set ws = ActiveSheet 'This can be changed to a specific sheet: Worksheets("sheetName")

    With ws

        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
            If .Cells(i, 1).Value = .Cells(i + 1, 1).Value Then
                .Rows(i).Delete
            End If
        Next i
    End With
End Sub

如何编辑此代码，以便适用于3列？

Answer 1

在

/ruf3q.jpg“ alt =”在此处输入图像描述”>

Option Explicit

Sub RemoveDupesShort()
    
    With ActiveSheet.UsedRange
        .Range("A3", .Cells(.Rows.Count, .Columns.Count)) _
            .RemoveDuplicates (VBA.Array(1, 2, 3))
    End With
    
    MsgBox "Duplicates removed.", vbInformation
    
End Sub

Sub RemoveDupes()
    
    ' Define constants.
    Const FirstCellAddress As String = "A3"
    Dim DupeCols() As Variant: DupeCols = VBA.Array("A", "B", "C")
    
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    ' For worksheet 'Sheet1' in the workbook containing this code, instead use:
    'Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Reference the range ('rg').
    Dim rg As Range
    With ws.UsedRange
        Set rg = ws.Range(FirstCellAddress, .Cells(.Rows.Count, .Columns.Count))
    End With
    
    ' Write the column numbers to a zero-based variant array ('Cols').
    
    Dim cUpper As Long: cUpper = UBound(DupeCols)
    Dim Cols() As Variant: ReDim Cols(0 To cUpper)
    
    Dim c As Long
    
    For c = 0 To cUpper
        Cols(c) = ws.Columns(DupeCols(c)).Column
    Next c
    
    ' Remove duplicates.
    rg.RemoveDuplicates (Cols)
    ' Note that the array of column numbers also needs to be evaluated:
    ' '(Cols)' which is short for 'Evaluate(Cols)'
    
    ' Inform.
    MsgBox "Duplicates removed.", vbInformation
    
End Sub