贴吧提问《哪位大神知道要怎么实现?》,Excel内置函数使用比较麻烦,VBA字典实现比较直观
自定义函数UNIQUE_IF筛选单元格区域中的值,可以选择返回其中的唯一值或重复值,并用分隔符分隔
函数更新,详见:《Excel·VBA自定义函数判断单元格元素相同/重复》
Function UNIQUE_IF(rng As Range, Optional delimiter As String = ",", Optional unique As Boolean = True)
'函数定义UNIQUE_IF(区域,分隔符,是否唯一值)
Dim arr, a, b, k, v, x, dict As Object, result As String
Set dict = CreateObject("scripting.dictionary")
arr = rng.Value
If Not IsArray(arr) Then '判断是否数组
UNIQUE_IF = arr
Else
For Each a In arr:
If IsArray(a) Then '单行、单列为否
For Each b In a:
'字典键-值,值为1即为唯一,值为2即为重复
If Not dict.Exists(b) Then dict(b) = 1 Else dict(b) = 2
Next
Else
If Not dict.Exists(a) Then dict(a) = 1 Else dict(a) = 2
End If
Next
End If
'根据字典数据返回结果
k = dict.keys
v = dict.Items
For x = 0 To dict.count - 1: '遍历字典
If unique = True And v(x) = 1 Then '返回唯一值
result = result & delimiter & k(x)
ElseIf unique = False And v(x) = 2 Then '返回重复值
result = result & delimiter & k(x)
End If
Next
Set dict = Nothing '清除字典,释放内存
Select Case result
Case ""
UNIQUE_IF = "#N/A#" '没有符合条件的筛选返回值,区分函数未正确运行"#N/A"
Case Else
UNIQUE_IF = Right(result, Len(result) - Len(delimiter)) '返回结果,同时去除开头的分隔符
End Select
End Function
Sub UNIQUE_IF帮助信息()
'运行一次后该帮助信息生效
Dim 函数名称 As String '函数名称
Dim 函数描述 As String '函数描述
Dim 参数(0 To 2) As String '函数参数描述 数组 个数
函数名称 = "UNIQUE_IF"
函数描述 = "筛选单元格区域中的值,返回其中是/否唯一的值,并用分隔符分隔"
参数(0) = "单元区域"
参数(1) = "分隔符,默认为“,”"
参数(2) = "返回唯一值或重复值,“TRUE/1”表示唯一值,“FALSE/0”表示重复值,逻辑值"
Call Application.MacroOptions(macro:=函数名称, Description:=函数描述, ArgumentDescriptions:=参数)
End Sub