求助老师一段VBA（说明在附件）

三票

求助老师一段VBA（说明在附件）

wengjl

楼主的说明写得太深奥啦，没法看懂

liulang0808

建议楼主结合附件再细化下描述以及结果说明
比如：尾数部分是不是就这几个？？？

三票

liulang0808 发表于 2023-1-9 08:11
建议楼主结合附件再细化下描述以及结果说明
比如：尾数部分是不是就这几个？？？

版主大师附件中补充了说明

2900357148

楼主试一下这个，测试没啥问题
Sub 计算()
    Dim ArrAll, Arr1, Arr2
    Dim Str1$
    Dim i As Long, j%, m%, n%
    Dim dic1 As Object
    Dim dic2 As Object
    Excel.Application.ScreenUpdating = False
    Arr1 = Array("Q2", "X2", "AE2", "AL2", "AS2") '五个数据范围的位置
    Set dic1 = CreateObject("scripting.dictionary")
    ArrAll = Cells(10, 3).CurrentRegion
    For i = LBound(ArrAll, 1) To UBound(ArrAll, 1)
        For j = LBound(ArrAll, 2) To UBound(ArrAll, 2)
            If ArrAll(i, j) <> "" Then
                ArrAll(i, j) = CInt(Right(ArrAll(i, j), 1))
                dic1(ArrAll(i, j)) = ""
            End If
        Next j
        Cells(i + 9, 17).Value = dic1.Count
        Set dic2 = dic1
        For j = 0 To 4
            Arr2 = Range(Arr1(j)).CurrentRegion
            For m = 2 To UBound(Arr2, 1)
                For n = 1 To UBound(Arr2, 2)
                    If Arr2(m, n) <> "" Then dic1(Arr2(m, n)) = ""
                Next n
            Next m
            Cells(i + 9, 18 + j).Value = dic1.Count
            Set dic1 = dic2
        Next j
        dic1.RemoveAll
    Next i
    Range("J10").Resize(UBound(ArrAll, 1), UBound(ArrAll, 2)) = ArrAll
    Set dic1 = Nothing
    Set dic2 = Nothing
    Excel.Application.ScreenUpdating = True
End Sub

陆离Lowry

有个尾数8是打漏了还是要求就这样？

LIUZHU

三票 发表于 2023-1-9 08:53
版主大师附件中补充了说明

老大，你写说明的时候，麻烦考虑下读者的感受，把句子写清楚些啊。
比如这句
“每组数据尾数含有0—9中数字的个数重复的算一个”
我理解的意思应该是：每组数据尾数含有0-9的个数（重复的算一个），例如1，2，7，4，2，9，包含0-9的是1，2，7，4，9（2是重复的，算一个）。

3190496160

看了半天，一头雾水哟，实在看不懂模拟的结果

LIUZHU

三票 发表于 2023-1-9 08:53
版主大师附件中补充了说明

一行中数据为空格怎么处理？当做0，还是不处理？

陆离Lowry

有个尾数8怎么没了，不知道是打漏了还是就这么处理的，按打漏了的写一个，猜的不知道对不对