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

YZC51

玉阳山人 发表于 2019-11-3 06:23
恳请老师按附件要求，编写自定义函数的代码。

不好意思，等下，抽时间看看！

YZC51

玉阳山人 发表于 2019-11-3 06:23
恳请老师按附件要求，编写自定义函数的代码。

请参考

Public Function ZFJS(rng, Optional t = "", Optional x = 0)
    arr = rng
    m = 0: n = 0
    For i = 1 To UBound(arr)
        For j = 1 To Len(arr(i, 1))
            m = m + 1
            If CStr(Mid(arr(i, 1), j, 1)) = CStr(t) Then n = n + 1
        Next
    Next
    If x Then ZFJS = n Else ZFJS = m
End Function

YZC51

玉阳山人 发表于 2019-11-3 06:23
恳请老师按附件要求，编写自定义函数的代码。

效果图

玉阳山人

YZC51 发表于 2019-11-3 16:27
请参考

Public Function ZFJS(rng, Optional t = "", Optional x = 0)

首先，衷心感谢老师于百忙中抽出时间帮忙！

   测试后发现：1.您写的代码，和附件里的运算规则和要求比较，多了第三参数1；

                       2.只能以普通公式输入，无法使用区域数组公式输入-- 如选定C5:C14，输入  { =ZFJS(A5:A100000,B5:B14) ，则显示如C5:C14的计算结果。

YZC51

优化下
Public Function ZFJS(rng, Optional t = "")
    arr = rng
    m = 0: n = 0
    For i = 1 To UBound(arr)
        For j = 1 To Len(arr(i, 1))
            m = m + 1
            If CStr(Mid(arr(i, 1), j, 1)) = CStr(t) Then n = n + 1
        Next
    Next
    If t = "" Then ZFJS = m Else ZFJS = n
End Function

玉阳山人

YZC51 发表于 2019-11-3 19:04
优化下
Public Function ZFJS(rng, Optional t = "")
    arr = rng

上面提到的第一个问题已完美解决，感谢老师！

YZC51

玉阳山人 发表于 2019-11-3 18:45
首先，衷心感谢老师于百忙中抽出时间帮忙！

   测试后发现：1.您写的代码，和附件里的运算规则和 ...

使用区域数组公式会拖慢运算速度！

玉阳山人

YZC51 发表于 2019-11-3 19:22
使用区域数组公式会拖慢运算速度！

感谢老师提醒！

YZC51

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

玉阳山人

YZC51 发表于 2019-11-3 22:55
Function qqc(Rng As Range, Optional x = 0) '单元格内或者区域去重
    'x=1 区域去重排序、x=0 区域去 ...

怎么回事，输入公式=QQC($A$5:$A$100000,1)或=QQC($A$5:$A$100000,1)后，都会显示#VALUE!错误？