Public Sub 单列去重(sr As Range, tr As Range)    'sr向下扩展的单列去重输出到tr
    Dim i&, arr, s, keys
    Dim dic
    Set sr = Range(sr, sr.End(xlDown))
    arr = sr
    Set dic = CreateObject("scripting.dictionary")
    
    For i = 1 To UBound(arr)    '去重
        If arr(i, 1) <> "" Then
            If Not dic.Exists(arr(i, 1)) Then dic.Add arr(i, 1), Nothing
        End If
    Next
    
    ReDim arr(0 To dic.Count - 1, 0)
    keys = dic.keys
    
    For i = 0 To dic.Count - 1
        arr(i, 0) = keys(i)
    Next
    tr.Resize(dic.Count) = arr
End Sub