快速删除重复数据行

实例需求：在如下图的数据记录表中删除重复数据行。

• 每行数据包含5个数据
• 每行数据都是无序排列
• 如果两行中全部数据元素都相同，那么视为重复数据，例如第4行，第7行，第10行
• 对于重复数据只保留首次出现的数据行

于是数据是无序排列的，那么对比两个数据行中的数据就比较麻烦，当然可以采用多重循环，但是效率会比较差，因此这里借助JavaScript实现数组排序，将每行中的5个数据排序，然后再进行对比。

排序代码如下：

Function JSSortNum(ByVal strNum As String)
    Set objJS = CreateObject("msscriptcontrol.scriptcontrol")
    objJS.Language = "javascript"
    objJS.addcode "function sortarr(para){arr=para.split(',');arr.sort(function cmp(a,b){return a-b;});return arr;}"
    JSSortNum = objJS.eval("sortarr('" & strNum & "')")
End Function

排序代码解释请参考： 数组排序系列（4）

示例代码如下：

Sub Demo()
    Dim rngRes As Range, objDic, arr, i, j, sNum, sKey
    Set objDic = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion.Value
    For i = 1 To UBound(arr)
        sNum = ""
        For j = 1 To 5
            sNum = sNum & "," & arr(i, j)
        Next
        sKey = JSSortNum(Mid(sNum, 2))
        'Debug.Print sNum, sKey
        If Not objDic.exists(sKey) Then
            objDic(sKey) = i
        Else
            If rngRes Is Nothing Then
                Set rngRes = Cells(i, "C").Resize(1, 5)
            Else
                Set rngRes = Union(rngRes, Cells(i, "C").Resize(1, 5))
            End If
        End If
    Next
    If Not rngRes Is Nothing Then
        'rngRes.Interior.Color = vbYellow
        rngRes.EntireRow.Delete
    End If
End Sub

【代码解析】
第2行代码创建字典对象。
第3行代码将数据加载到数组中。
第5~21行代码序号处理数据。
第7~9行代码将一行中的5个数据组合为字符串。
第10行代码调用JSSortNum函数进行排序。
第12行代码判断排序后的字符串是否存在于字典对象中。
如果不存在，则第13行代码将字符串添加到字典对象中。
如果存在，那么当前数据行为重复数据，第15~19行代码将对应的数据行单元格区域保存在rngRes变量中。
如果rngRes变量不为空，那么第24行代码将删除一次性删除确保重复数据行。

由于循环过程需要多次调用JSSortNum函数，因此如果将其中的CreateObject代码行移到主过程中，并将JavaScript对象作为参数传递，那么将避免多次创建JavaScript对象，整个代码运行效率更高。

---

运行示例代码Demo，将删除黄色的重复数据行。