我需要帮助创建一个非常具体的VBA功能。 我需要一个函数来分割单元格的值并用唯一值填充另一列。
我目前正在使用=IFERROR(INDEX(List,MATCH(0,INDEX(COUNTIF($A$1:A2,List),0,0),0)),"")
,以便从一列到另一列获取唯一值。
不幸的是,其中一些值将与“,”结合,但仍然需要是唯一的。
不幸的是,我对VBA的了解远非广泛。有没有人有任何建议?
答案 0 :(得分:2)
假设我们有以下数据:
在 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