字典的特性决定了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