ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: YZC51

[讨论] 自定义函数--提取单元格内多个被分开的数字

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-27 12:56 | 显示全部楼层
浮生若梦~~~ 发表于 2020-3-27 10:07
那么晚还在折腾,谢谢!主要是姓名去重,能做成公式下拉就好了

提供个思路、首先是替换成统一的分隔符,用分列公式,然后提取重复值就可以

TA的精华主题

TA的得分主题

发表于 2020-3-27 13:27 | 显示全部楼层
summeren 发表于 2020-3-27 12:56
提供个思路、首先是替换成统一的分隔符,用分列公式,然后提取重复值就可以

不用分列我都可以公式提取出来,就是麻烦,得两个公式.想一个公式提取

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-27 14:49 | 显示全部楼层
浮生若梦~~~ 发表于 2020-3-27 10:07
那么晚还在折腾,谢谢!主要是姓名去重,能做成公式下拉就好了

您好!公式不会呀!

TA的精华主题

TA的得分主题

发表于 2020-3-27 15:09 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
YZC51 发表于 2020-3-27 14:49
您好!公式不会呀!

我是不会,思路是先把姓名列每行的名字拆分成单独的装在自定义函数的数组里面,然后自定义函数下拉去重

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-28 12:13 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-3-28 19:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
老师呵,我的问题想到办法没

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-28 19:56 | 显示全部楼层
浮生若梦~~~ 发表于 2020-3-28 19:29
老师呵,我的问题想到办法没

老师你好!很抱歉,对于公式不熟悉!

TA的精华主题

TA的得分主题

发表于 2020-3-28 21:32 | 显示全部楼层
YZC51 发表于 2020-3-28 19:56
老师你好!很抱歉,对于公式不熟悉!

我感觉和你前面自定义的去重函数的差不多.区别在:前面那只是每列一行一个数据,现在是一行多个数据

TA的精华主题

TA的得分主题

发表于 2020-3-30 08:47 | 显示全部楼层
浮生若梦~~~ 发表于 2020-3-28 21:32
我感觉和你前面自定义的去重函数的差不多.区别在:前面那只是每列一行一个数据,现在是一行多个数据

我在老师的基础上写了一个,然后提取也可以多行多列,如果符号不同,只要在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

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-3-30 09:20 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
summeren 发表于 2020-3-30 08:47
我在老师的基础上写了一个,然后提取也可以多行多列,如果符号不同,只要在delimiter更新和修改符号就可 ...

感谢,达到了需要的效果
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-16 01:29 , Processed in 0.043844 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表