字典的特性决定了key必须是唯一的。所以可以用字典来提取唯一值，也就是去除重复。
-
单列去重复
源数据
Sub 去重复()
Dim arr, d As Object, i As Long
arr = Range("a1:A" & Cells(Rows.Count, 1).End(xlUp).Row)'数组赋值
Set d = CreateObject("scripting.dictionary")'创建字典
For i = 1 To UBound(arr)'遍历数组,将数组元素放进字典的key
d(arr(i, 1)) = ""
Next
'd.keys是一维数组，要放到单元格，必须转置
[b1].Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub
-
总之，字典里的key是唯一的。
结果
- 多行求唯一值：
源数据
Sub 去重复()
Dim arr, d As Object, i As Long
arr = Range("a1:b" & Cells(Rows.Count, 1).End(xlUp).Row)
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
d(arr(i, 1)) = arr(i, 2)
Next
[d1].Resize(d.Count, 1) = Application.Transpose(d.keys)
[e1].Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
Sub 去重复1()
Dim arr, d As Object, i As Long
arr = Range("a1:b" & Cells(Rows.Count, 1).End(xlUp).Row)
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
s = arr(i, 1) & "/" & arr(i, 2)
d(s) = ""
Next
End Sub
- 假如要求是两列相同的去重复，上面代码都能够可以。其中，Sub 去重复1()是将两列通过符号[ / ]合并在一起，形成一个新的key，后面再用split函数分列处理（代码没写）。
- 上面两种方法都可以用exists来代替。
Sub 去重复2()
Dim arr, d As Object, i As Long, brr()
arr = Range("a1:b" & Cells(Rows.Count, 1).End(xlUp).Row)'将数据放进数组arr
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))'定义数组brr大小
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
s = arr(i, 1) & arr(i, 2)'如果是3列的要求就继续使用 & 链接....
If Not d.exists(s) Then'如果字典不存在s这个key
k = k + 1'计数
d(s) = k'不存在s这个key就让它存在
For j = 1 To UBound(arr, 2)'将数组arr的值通过遍历放到数组brr
brr(k, j) = arr(i, j)
Next
End If
Next
[d1].Resize(k, UBound(brr, 2)) = brr'输出唯一值
End Sub
- 用exists的方法，可以直接方便将唯一的数据放进数组，直接输出。不用转置（效率低），不用管数据是要求几列的唯一值。
