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

76 篇文章 23 订阅

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

在这里插入图片描述

  • 0
    点赞
  • 10
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

薛定谔_51

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值