VBA函数使用唯一的分割条目填充列

我需要帮助创build一个非常具体的VBAfunction。 我需要一个函数，将分裂一个单元格的值，并填充另一列与唯一值。

我目前正在使用=IFERROR(INDEX(List,MATCH(0,INDEX(COUNTIF($A$1:A2,List),0,0),0)),"") ，以便从一列中获得唯一的值到另一个。 不幸的是，这些值中的一部分将与“，”连接，但仍然是唯一的。

不幸的是，我对VBA的了解还远远不够。 有没有人有什么build议？

Answer 1

假设我们有这样的数据：

在A列。 运行这个macros将提取唯一的，然后在列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列的一部分，然后以数组formsinputUDF

编辑＃2

这里是与chris neilsen的build议UDF ：

 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