VBA用于使用唯一的拆分条目填充列的功能

Question

我需要帮助创建一个非常具体的VBA功能。 我需要一个函数来分割单元格的值并用唯一值填充另一列。

我目前正在使用=IFERROR(INDEX(List,MATCH(0,INDEX(COUNTIF($A$1:A2,List),0,0),0)),"")，以便从一列到另一列获取唯一值。 不幸的是，其中一些值将与“，”结合，但仍然需要是唯一的。

不幸的是，我对VBA的了解远非广泛。有没有人有任何建议？

Answer 1

假设我们有以下数据：

在 A 栏中。运行此宏将提取唯一身份，然后将其放在 B ：

列中

Sub dural()
    Dim c As Collection, K As Long
    Set c = New Collection
    K = 1
    On Error Resume Next
    For Each r In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        ary = Split(r.Text, ",")
        For Each a In ary
            c.Add a, CStr(a)
            If Err.Number = 0 Then
                Cells(K, "B").Value = a
            K = K + 1
            Else
                Err.Number = 0
            End If
        Next a
    Next r
    On Error GoTo 0
End Sub

修改＃1：

以下是 UDF 形式的相同逻辑：

Public Function UniKues(rIn As Range)
    Dim c As Collection, K As Long
    Set c = New Collection
    K = 1
    On Error Resume Next
    For Each r In rIn
        ary = Split(r.Text, ",")
        For Each a In ary
            c.Add a, CStr(a)
        Next a
    Next r

    ReDim bry(1 To c.Count, 1 To 1)
    For i = 1 To c.Count
        bry(i, 1) = c.Item(i)
    Next i
    UniKues = bry
    On Error GoTo 0

End Function

只需点亮 B 列的一部分，然后在数组表单中输入 UDF

修改＃2

以下是 UDF 以及 chris neilsen的建议：

Public Function UniKues(rIn As Range)

    Dim c As Collection, K As Long, MM As Long
    Dim CC As Long
    Set c = New Collection
    K = 1
    On Error Resume Next
    For Each r In rIn
        ary = Split(r.Text, ",")
        For Each a In ary
            c.Add a, CStr(a)
        Next a
    Next r
    MM = Application.Caller.Rows.Count
    CC = c.Count
    dimn = Application.WorksheetFunction.Max(MM, CC)
    ReDim bry(1 To dimn, 1 To 1)
    For i = 1 To CC
        bry(i, 1) = c.Item(i)
    Next i
    If MM > CC Then
        For i = CC + 1 To MM
            bry(i, 1) = ""
        Next i
    End If
    UniKues = bry
    On Error GoTo 0

End Function