VBA常用小代码301：用字典提取不重复值并计数

数据去重复一直是数据整理过程中常见的问题之一，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，字典认为并不重复。

另外，即便数据区域的数值不存在文本型数值，也建议将之强制转换为字符串类型。

我是男神，我是星光，握爪，致安，下期见~

VBA编程学习与实践

易学宝微视频教程，1290个Office技巧精粹，每个技巧都与实际工作密切相关。轻松学习技巧，练就职场达人。淘宝搜索关键字：ExcelHome易学宝

本公众号回复关键字：大礼包立刻免费获取50集精选易学宝教程