如何在没有太多循环的情况下删除几列中的重复行？

Question

大多数问题都集中在单列重复项上，这更容易且计算量更少。

我创建了一个脚本，该脚本将删除多个列中的重复行-意味着如果所有列的值与另一行完全相同，则它是重复行，应删除。问题是，由于嵌套的for-next循环，效率太低。如果该工作簿具有1200行和7列，则将有1200 x 1200 x 7次运行，大约等于一千万次运行。我知道数组会更快，但是我更担心找到一种减少循环次数的方法。

代码如下所示：

Option Explicit
Function RemoveNonTableDuplicate()
Dim Range_scanned As Range, Range_compared As Range, i As Long, j As Long, x As Long, z As Long, Match As Long, Sheet_name As String, Workbook_name As String, Total_rows As Long

Workbook_name = InputBox("Please Input the Workbook Name", "Identify Workbook Name")
Sheet_name = InputBox("Please Input the Worksheet Name", "Identify Worksheet Name")

Start:
Total_rows = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Total_rows
    Match = 0
    Set Range_scanned = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & i & ":E" & i)
    For j = 2 To Total_rows
        Set Range_compared = Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & j & ":E" & j)
        For z = 1 To TotalColumnsCount(Workbooks(Workbook_name).Name, Sheet_name)
            If Range_scanned(z) = Range_compared(z) Then
                x = x + 1
            End If
        Next z
        If x = TotalColumnsCount(Workbooks(Workbook_name).Name, Sheet_name) Then
            Match = Match + 1
        End If
        x = 0
        If Match > 1 Then
            Workbooks(Workbook_name).Worksheets(Sheet_name).Range("A" & j & ":E" & j).Delete Shift:=xlUp
            GoTo Start
        End If
    Next j
Next i
End Function

为说明代码应如何工作，请参考下图。

在运行代码之前：

运行代码以删除重复项后：

Answer 1

是什么阻止您使用此功能？

Range("A:E").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes