|
我在老师的基础上写了一个,然后提取也可以多行多列,如果符号不同,只要在delimiter更新和修改符号就可以;
Public Function UNIQUEQ(rng, Optional x As Integer)
'数组公式提取不重复值,默认提取,大于1 则输出不重复值(可单列也可以多行多列),可提取单个单元格用符号分开的数据
On Error Resume Next
Set d = CreateObject("Scripting.Dictionary")
Delimiter = [{",",";","、",","," "}] '分隔符号
For Each a In rng
For i = LBound(Delimiter) To UBound(Delimiter)
a = Replace(a, Delimiter(i), " ") '所有的分隔符转换成 空格
Next
spl = spl & " " & a
Next
arr = Split(Application.Trim(spl), " ") '将前后的空格去除
For i = 0 To UBound(arr) '循环数组arr1
If Not d.exists(arr(i)) Then ' 如果字典里不存在,那就装入字典
d(arr(i)) = ""
End If
Next
brr = d.Keys
If x Then UNIQUEQ = UBound(brr) + 1: Exit Function
On Error Resume Next
UNIQUEQ = brr(0)
With Application.ThisCell
'清除原先生成的不重复
For i = 1 To rng.Count
If .Offset(i) = "" Then s = Null Else s = "*"
.Offset(i).Replace s, ""
Next
For j = 1 To UBound(brr, 1)
If .Offset(j) = "" Then s = Null Else s = "*"
.Offset(j).Replace s, brr(j)
Next j
End With
Set d = Nothing
End Function |
评分
-
2
查看全部评分
-
|