数据去重复一直是数据整理过程中常见的问题之一,Excel解决方法有【删除重复项】、【高级筛选】、【数据透视表】、SQL语句、VBA的字典和集合等等……各有所长也各有所短。 可能还有小伙伴说还有函数……那啥……坦白说,“去重”一直都是函数最大的硬伤之一,虽然数组公式可以实现,但那些数组公式的适应性、可操作性和运算效率都是渣渣的一匹。说来也是奇怪……绝大部分语言都有专门的去重函数,比如distinct,但偏偏Excel函数没有……从03到16十几年过去……一直没有…………。 说正事儿……今天和大家分享的方法是VBA的字典法……。
举个栗子。 如下图所示,A列是一些数据,可能存在重复值,需要在C列得出不重复值,并告知不重复值的个数。 代码如下: Sub Mydistinct() 'vba编程学习与实践~看见星光 Dim d As Object, arr, brr, i&, k&, s$ Set d = CreateObject('scripting.dictionary') '后期引用字典 'd.CompareMode = vbTextCompare '不区分字母大小写 arr = Range('a1:a' & Cells(Rows.Count, 1).End(xlUp).Row) '数据源装入数组arr ReDim brr(1 To UBound(arr), 1 To 1) '声明一个数组brr放结果。 For i = 2 To UBound(arr) '标题行不要,从第2行开始遍历 s = arr(i, 1) '强制将数据转换成字符串类型,原因见小贴士 If Not d.exists(s) Then d(s) = '' '如果字典中不存在s,则作为关键字装入字典 k = k + 1 '累加个数 brr(k, 1) = arr(i, 1) '装入结果数组 End If Next [c:c].ClearContents [c1] = '结果' With [c2].Resize(k, 1) .NumberFormat = '@' '设置文本格式,防止某些文本数值变形 .Value = brr End With MsgBox '欲淑临疯的星光大叔,一共为你提取了:' & k & '个不重复值。' Set d = Nothing '释放字典 End Sub 运算结果: 小贴士: 1,该段代码区分字母大小写,即A和a并不重复,如果需要不区分字母大小写,解除代码中下面语句的注释块。 d.CompareMode = vbTextCompare 2,代码中有一句s = arr(i, 1),意思是将数据类型转换为字符串变量s。之所以这么操作,是因为字典关键字认为数值和文本型数值是不相等的,举个例子,如下图,数值123和文本123,字典认为并不重复。 另外,即便数据区域的数值不存在文本型数值,也建议将之强制转换为字符串类型。 |
|