使用唯一项将一维数组填充到行或列

Question

在我的 sheet 中，我有一列包含一些数据，并且在某些单元格中有多个项目，用逗号分隔例如：

Ahmed
Reda, Salah
Yasser, Nader, Hany
Kamal
Nader, Ali, Ahmed

这是提取唯一项目并将其填充到行而不是列的 udf。

Function UniqueItems(ByVal rng As Range, ByVal delim As String, ByVal f As Boolean)
    Dim strPart, ky, c As Range, dic As Object, temp As String
    If f = True Then
    Dim strArr() As String
    Else
    'how to make it 2d array
    Dim strArr() As String
    End If
    Set dic = CreateObject("Scripting.Dictionary")
    For Each c In rng
        If c.Value <> "" Then
            strArr = Split(c.Value, delim)
            For Each strPart In strArr
                On Error Resume Next
                    dic.Add Trim(strPart), Trim(strPart)
                On Error GoTo 0
            Next strPart
            temp = ""
            For Each ky In dic
                temp = temp & ky & delim
            Next ky
        End If
    Next c
    Dim v
    v = Split(Left(temp, Len(temp) - Len(delim)), delim)
    If f = True Then
        UniqueItems = Split(Left(temp, Len(temp) - Len(delim)), delim)
    Else
        ''how to make it for column
    End If
End Function

如何在 udf 参数中添加另一个参数来决定用户是希望该结果列表位于行中还是列中？

另外一点可能的话，我想对结果进行排序，我又用了一个udf

Function SortArray(myArray As Variant, bOrder As Boolean)
    Dim temp, i As Long, j As Long
    For i = LBound(myArray) To UBound(myArray) - 1
        For j = i + 1 To UBound(myArray)
            If IIf(bOrder, UCase(Trim(Replace(myArray(i), "/", ""))) > UCase(Trim(Replace(myArray(j), "/", ""))), UCase(Trim(Replace(myArray(i), "/", ""))) < UCase(Trim(Replace(myArray(j), "/", "")))) Then
                temp = myArray(j)
                myArray(j) = myArray(i)
                myArray(i) = temp
            End If
        Next j
    Next i
    SortArray = myArray
End Function

但是 udf 没有按预期排序

数据：

预期：

Answer 1

我修改了你的函数，让代码更简洁。您会注意到最后一个参数是可选的，它决定函数 return 是水平数组还是垂直数组。

因此，如果没有参数传递给函数或传递的参数为 FALSE，则函数 return 是一个水平数组。如果传递的是 TRUE，则它 return 是一个垂直数组。

Function UniqueItems(ByVal rng As Range, ByVal delim As String, Optional ByVal transpose As Boolean = False)

    Dim dic As Object
    Dim c As Range
    Dim strArr() As String
    Dim strPart As Variant
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    For Each c In rng
        If c.Value <> "" Then
            strArr() = Split(c.Value, delim)
            For Each strPart In strArr
                dic(Trim(strPart)) = ""
            Next strPart
        End If
    Next c
    
    If transpose = True Then
        UniqueItems = Application.transpose(dic.keys())
    Else
        UniqueItems = dic.keys()
    End If
    
End Function

到return一个横排。 . .

=UniqueItems(A1:A100, ",")

或

=UniqueItems(A1:A100, ",", FALSE)

到return一个垂直数组。 . .

=UniqueItems(A1:A100, ",", TRUE)

使用唯一项将一维数组填充到行或列

Populate 1d array to rows or column with unique items

excel

vba