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

YZC51

玉阳山人 发表于 2019-11-3 23:19
怎么回事，输入公式=QQC($A$5:$A$100000,1)或=QQC($A$5:$A$100000,1)后，都会显示#VALUE!错误？

试试

Function qc(Rng, Optional x = 0) '单元格内或者区域去重
'第二参数省略为去重计数；不等于0时提取不重复字符！
    Dim i As Long, dic
    arr = Rng
    Set dic = CreateObject("scripting.dictionary")
    For j = 1 To UBound(arr)
        For i = 1 To Len(arr(j, 1))
            If Not dic.Exists(Mid(arr(j, 1), i, 1)) Then
                dic(Mid(arr(j, 1), i, 1)) = ""
            End If
        Next
    Next
    qc = Join(dic.keys, "")
    If x = 0 Then qc = Len(qc)
End Function

Function qqc(Rng, Optional x = 0) '单元格内或者区域去重
    'x=1 区域去重排序、x=0 区域去重计数
    '除汉字、全角字符、特殊字符以外的所有字符串
    Dim i As Long, arr(255)
    brr = Rng
    On Error Resume Next '
    For j = 1 To UBound(brr)
        For i = 1 To Len(brr(j, 1))
            arr(Asc(Mid(brr(j, 1), i, 1))) = Mid(brr(j, 1), i, 1)
        Next
    Next
    qqc = Join(arr, "")
    If x = 0 Then qqc = Len(qqc)
End Function

YZC51

玉阳山人 发表于 2019-11-3 19:23
感谢老师提醒！

请参考附件
对区域内的指定数字进行计数-.zip (20.58 KB, 下载次数: 26)

2019-11-4 08:56 上传

点击文件名下载附件

玉阳山人

YZC51 发表于 2019-11-4 07:30
请参考附件

感谢老师！多个代码比较之下，觉得还是http://club.excelhome.net/forum. ... 87&pid=10134250  的代码最能实现我的初衷！

YZC51

玉阳山人 发表于 2019-11-4 07:52
感谢老师！多个代码比较之下，觉得还是http://club.excelhome.net/forum.php?mod=redirect&goto=findpost ...

附件已经更新，请重新下载

玉阳山人

YZC51 发表于 2019-11-4 07:30
请参考附件

这个代码很合我需！谢谢老师！

玉阳山人

YZC51 发表于 2019-11-4 08:56
附件已经更新，请重新下载

补送几朵花花，以感谢老师的倾力帮助之情。

YZC51

玉阳山人 发表于 2019-11-5 15:39
补送几朵花花，以感谢老师的倾力帮助之情。

不客气！谢谢花花鼓励！

iris00

YZC51 发表于 2019-11-1 16:05
如下代码替换Sheet1模块里的代码
Private Sub ToggleButton1_Click()
    Dim JGD As Shape

我复制过去，还是同样的提示。奇怪到底哪里出问题了呢？

YZC51

iris00 发表于 2019-11-7 10:50
我复制过去，还是同样的提示。奇怪到底哪里出问题了呢？

上传附件，分析下原因

iris00

直接复制楼主的一张表是好用的。再复制一张，第二张表的开关就不能正常使用，开关是受第一张表控制。第三张表是复制代码，总出问题提示缺少SUB。