贴吧提问《哪位大神知道要怎么实现?》,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 StringSet dict = CreateObject("scripting.dictionary")arr = rng.ValueIf Not IsArray(arr) Then '判断是否数组UNIQUE_IF = arrElseFor 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) = 2NextElseIf Not dict.Exists(a) Then dict(a) = 1 Else dict(a) = 2End IfNextEnd If'根据字典数据返回结果k = dict.keysv = dict.ItemsFor 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 IfNextSet dict = Nothing '清除字典,释放内存Select Case resultCase ""UNIQUE_IF = "#N/A#" '没有符合条件的筛选返回值,区分函数未正确运行"#N/A"Case ElseUNIQUE_IF = Right(result, Len(result) - Len(delimiter)) '返回结果,同时去除开头的分隔符End SelectEnd FunctionSub 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