Excel·VBA自定义函数筛选单元格区域重复值

贴吧提问《哪位大神知道要怎么实现?》,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
举例

Excel·VBA自定义函数筛选单元格区域重复值_第1张图片

你可能感兴趣的:(#,Excel,VBA,excel,vba)