excel - 如果整行使用 VBA 匹配，则删除重复的行

Question

我正在尝试创建一个子程序，仅当整个行值重复时才删除重复的行(我的工作表有 20 列)。函数RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes将删除错误的行，因为我可能在所有单元格中都有重复的值，但绝不可能是整行。我尝试使用 RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes但它给了我一个错误。所以我决定制作以下代码。代码的问题是我要遍历所有单元格来验证任何重复的行。有没有更简单的方法来做到这一点？
谢谢!

Public Sub DeleteDupRows()

    Dim plLine As Integer: plLine = 2                   'sheet have header
    Dim plColumn As Integer: plColumn = 1
    
    Dim rowReferece As Integer: rowReferece = 2         'rows and columns used to search
    Dim columnReference As Integer: columnReference = 1
    
    Dim duplicated As Integer: duplicated = False
    
    Set pl = ThisWorkbook.Worksheets("BD - Tarifas")
    
    While pl.Cells(plLine, plColumn) <> ""
        While pl.Cells(rowReferece, columnReference) <> ""
        
        rowReferece = rowReferece + 1
        duplicated = False
        columnReference = 1
        
            While pl.Cells(plLine, columnReference) = pl.Cells(rowReferece, columnReference) And pl.Cells(plLine, columnReference) <> ""   'True remains if we get through all columns
                duplicated = True
                columnReference = columnReference + 1
            Wend
        Wend
        
        If (duplicated = True) Then pl.Cells(rowReferece, columnReference).EntireRow.Delete
        
        plLine = plLine + 1
        rowReferece = plLine
        columnReference = 1
    Wend
End Sub

Answer 1

删除重复行 (RemoveDuplicates)

当Columns的参数RemoveDuplicates 的参数方法应该引用多个列，以下规则适用:

数组必须声明为 Variant .

数组必须从零开始。

必须评估数组，例如Evaluate(...)或只是 (...) .

如果一行单元格中的所有值都相等，则以下内容将删除重复项。

假设数据(表格，即一行标题)从单元格 A1 开始.

Sub removeDupes()
    Dim rg As Range
    Set rg = ThisWorkbook.Worksheets("BD - Tarifas").Range("A1").CurrentRegion
    Dim cUpper As Long: cUpper = rg.Columns.Count - 1
    Dim cData As Variant: ReDim cData(0 To cUpper)
    Dim n As Long
    For n = 0 To cUpper
        cData(n) = n + 1
    Next n
    rg.RemoveDuplicates (cData), xlYes
End Sub

您可以使用范围和 Header当您可以重写为以下内容时作为参数...

Sub removeDupeRows( _
        ByVal rg As Range, _
        Optional ByVal Header As XlYesNoGuess = xlYes)
    If rg Is Nothing Then Exit Sub
    Dim cUpper As Long: cUpper = rg.Columns.Count - 1
    Dim cData As Variant: ReDim cData(0 To cUpper)
    Dim n As Long
    For n = 0 To cUpper
        cData(n) = n + 1
    Next n
    rg.RemoveDuplicates (cData), Header
End Sub

...然后您可以使用它，例如通过以下方式:

Sub removeDupeRowsTEST()
    Dim rg As Range
    Set rg = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    removeDupeRows rg
End Sub