Function ПОЛУЧИТЬ_УНИКАЛЬНЫЕ(Rng As Range) As Variant
Dim tmpArray()
Dim unArray$()
On Error Resume Next
tmpArray = Rng.Value
ReDim unArray$(0 To Application.Caller.Rows.Count, 0 To 0)
With New Collection
    For I = LBound(tmpArray, 1) To UBound(tmpArray, 1)
        For J = LBound(tmpArray, 2) To UBound(tmpArray, 2)
            .Add tmpArray(I, J), CStr(tmpArray(I, J))
            If Err = 0 Then
                unArray(N, 0) = CStr(tmpArray(I, J))
                N = N + 1
            Else
                Err.Clear
            End If
        Next
    Next
End With
ПОЛУЧИТЬ_УНИКАЛЬНЫЕ = unArray
End Function