欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页

快速删除重复数据行

程序员文章站 2022-04-13 23:14:01
...

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

  • 每行数据包含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行代码将删除一次性删除确保重复数据行。


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