快速删除重复数据行
程序员文章站
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,将删除黄色的重复数据行。
上一篇: 新手怎么学五笔