VBA功能可在工作表的同一行中的不同单元格上输出所有唯一值

Question

我正在尝试创建一个函数（当您将其传递给数组（也许是一个更好的范围？）时，该函数将在同一行上的所有唯一值输出到不同的单元格中。我已经知道如何识别元素（我认为我做的不正确:(），但是我不确定如何输出所有唯一值。我只能得到第一个。
我的代码如下：

    Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
 '   Accepts an array or range as input
'   If Count = True or is missing, the function returns the number of unique elements
'   If Count = False, the function returns a variant array of unique elements
Dim Unique() As Variant ' array that holds the unique items
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean

'If 2nd argument is missing, assign default value
If IsMissing(Count) Then Count = True
'   Counter for number of unique elements
NumUnique = 0
'   Loop thru the input array
For Each Element In ArrayIn
    FoundMatch = False
'       Has item been added yet?
    For i = 1 To NumUnique
        If Element = Unique(i) Then
            FoundMatch = True
            Exit For '(exit loop)
        End If
    Next i
AddItem:
   'If not in list, add the item to unique list
    If Not FoundMatch And Not IsEmpty(Element) Then
        NumUnique = NumUnique + 1
        ReDim Preserve Unique(NumUnique)
        Unique(NumUnique) = Element
    End If

    Next Element 
 If Count Then UniqueItems = NumUnique Else UniqueItems = Unique

Answer 1

就像是：

Function UniqueItems(ArrayIn) As Variant
    Dim vData As Variant
    Dim vNewdata() As Variant
    Dim colUniques As Collection
    Dim lCt As Long
    If TypeName(ArrayIn) = "Range" Then
        vData = ArrayIn.Value
    Else
        vData = ArrayIn
    End If
    Set colUniques = New Collection
    'assuming a one-column range

    On Error Resume Next 'ignore duplicates

    For lCt = 1 To UBound(vData, 1)
        colUniques.Add vData(lCt, 1), CStr(vData(lCt, 1))
    Next
    ReDim vNewdata(1 To 1, 1 To colUniques.Count)
    For lCt = 1 To colUniques.Count
        vNewdata(1, lCt) = colUniques(lCt)
    Next
    UniqueItems = vNewdata
End Function

Answer 2

您可以使用Scripting.dictionary快速获得独特的价值，例如

Sub TestArray()
Dim arrStart() As Variant
Dim oDic As Scripting.Dictionary

arr = Array(1, 1, 1, 2, 3, 4, 4, 5)

Set oDic = uniquevalue(arr)

'Note : put data into array
Dim arrResult() As Variant
arrResult = oDic.Keys
'Note : put data into string
Dim stringResult As String
stringResult = Join(oDic.Keys, ";")
End Sub

Function uniquevalue(ByVal myArray) As Scripting.Dictionary
'Note : Add REF DLL Microsoft Srcipting Runtime before !!
'Note : Option base =0 (standard vbe param)
'Note : Array is mono dimension of any data type
Dim oDic As Scripting.Dictionary
Set oDic = New Scripting.Dictionary

    For i = LBound(myArray) To UBound(myArray)
        If Not oDic.Exists(myArray(i)) Then oDic.Add myArray(i), oDic.Count
    Next i

Set uniquevalue = oDic
End Function