求计算三位数连号个数和基数的自定义函数

玉阳山人

求三位数连号个数和基数的自定义函数.zip (19.52 KB, 下载次数: 15)

2019-12-18 13:30 上传

点击文件名下载附件

三位数求连号个数的函数公式：B5 =COUNT(MATCH({1,2,3},FIND(MID($A5,{1,2,3},1)-1,A5),))

三位数求连号基数的函数公式：C5 { =SUBSTITUTE(TEXT(SUBSTITUTE(SUM(IFERROR(SUBSTITUTE(MID($A5,FIND(MEDIAN(--MID($A5,{1,2,3},1))+{-1,0,1},$A5),1),0,11),)*(10^{2,1,0})),0,),"[>11];"),11,0)

不仅公式冗长，容易输错；而且当数据量大时，运算效率低下，无法卒忍。恳请感兴趣的老师们，按附件里的运算规则，帮忙创建个高效、快捷的自定义函数为盼。

玉阳山人

恳请感兴趣的老师们，按附件里的运算规则，帮忙创建个高效、快捷的自定义函数为盼。

lsdongjh

1. Option Explicit
   
2. 
   
3. Function LIANGHAO(varData As Variant, Optional intType As Integer = 0) As Variant
   
4.     Dim arrData As Variant, rgCur As Range
   
5.     Dim lngMax As Long, arrReturn As Variant
   
6.     Dim lngRow As Long, strTemp As String, arrTemp As Variant
   
7.    
   
8.     Set rgCur = Application.Caller
   
9.     lngMax = rgCur.Rows.Count
   
10.     ReDim arrReturn(1 To lngMax, 1 To 2) As String
    
11.    
    
12.     intType = intType Mod 2 '偶数为0，奇数为1
    
13.     intType = intType + 1
    
14.    
    
15.     If IsArray(varData) Then
    
16.         arrData = varData
    
17.     Else
    
18.         ReDim arrData(1 To 1, 1 To 1)
    
19.         arrData(1, 1) = varData
    
20.     End If
    
21.    
    
22.     If UBound(arrData) < lngMax Then lngMax = UBound(arrData)
    
23.    
    
24.     For lngRow = LBound(arrData) To lngMax
    
25.         strTemp = Trim(arrData(lngRow, 1))
    
26.         If Len(strTemp) = 3 Then
    
27.             arrTemp = CheckNum(strTemp)
    
28.             arrReturn(lngRow, 1) = arrTemp(0)
    
29.             arrReturn(lngRow, 2) = arrTemp(1)
    
30.         End If
    
31.     Next
    
32.    
    
33.     LIANGHAO = Application.WorksheetFunction.Index(arrReturn, 0, intType)
    
34. End Function
    
35. 
    
36. 
    
37. Function CheckNum(strNum As String) As Variant
    
38.     Dim arrTemp(9) As String, intID As Integer
    
39.     Dim strTemp As String, strSplit() As String
    
40.     Dim arrResult(1) As String
    
41.     '规整源数据，剔除所有空格
    
42.     '未进行非数字剔除处理
    
43.     strNum = Trim(strNum)
    
44.     strNum = Replace(strNum, Space(1), "")
    
45.     If Len(strNum) <> 3 Then
    
46.         CheckNum = arrResult
    
47.         Exit Function
    
48.     End If
    
49.    
    
50.     For intID = 0 To 9
    
51.         arrTemp(intID) = Space(1)
    
52.     Next
    
53.    
    
54.     For intID = 1 To 3
    
55.         strTemp = Mid(strNum, intID, 1)
    
56.         arrTemp(Val(strTemp)) = strTemp
    
57.     Next
    
58.    
    
59.     strTemp = Trim(Join(arrTemp, ""))
    
60.     Do Until InStr(strTemp, Space(2)) = 0
    
61.         strTemp = Replace(strTemp, Space(2), Space(1))
    
62.     Loop
    
63.    
    
64.    
    
65.     strSplit = Split(strTemp, Space(1))
    
66.     Select Case UBound(strSplit)
    
67.         Case 2
    
68.             arrResult(0) = 0
    
69.             arrResult(1) = ""
    
70.         Case 1
    
71.             '有重号
    
72.             If Len(strSplit(0)) = 1 And Len(strSplit(1)) = 1 Then
    
73.                 arrResult(0) = 0
    
74.                 arrResult(1) = ""
    
75.             Else
    
76.                 arrResult(0) = 1
    
77.                 If Len(strSplit(0)) > Len(strSplit(1)) Then
    
78.                     arrResult(1) = strSplit(0)
    
79.                 Else
    
80.                     arrResult(1) = strSplit(1)
    
81.                 End If
    
82.             End If
    
83.         Case 0
    
84.             If Len(strSplit(0)) = 3 Then
    
85.                 arrResult(0) = 2
    
86.                 arrResult(1) = strSplit(0)
    
87.             Else
    
88.                 arrResult(0) = 0
    
89.                 arrResult(1) = ""
    
90.             End If
    
91.     End Select
    
92.     CheckNum = arrResult
    
93. End Function

复制代码

suzen631

1先按照百位，个位，十位找到三个数字，{A,B,C}，{--left（A1,1），--right（A1,1），--mid（A1,2,1））
2（max（ABC）-median（ABC）=1）+（median（ABC）-min（ABC）=1）=你需要的
试试运行速度怎么样？供参考

玉阳山人

lsdongjh 发表于 2019-12-18 17:28

老师请看：代码误把组选三的一连号当成了0连号--如下边的号码应该是一连号，但显示的计算结果却是0连号：

443
566
665
001
545
232
112
445
121
899
776
221
001

还有一个问题--连号个数计算结果应该显示为数值格式，否则无法直接进行下一步统计计算，如SUM(D5:D200)的结果等于0.

玉阳山人

lsdongjh 发表于 2019-12-18 17:28

数据源   连号个数   连号基数
443        1        34
566        1        56
665        1        56
001        1        01
545        1        45
232        1        23
112        1        12
445        1        45
121        1        12
899        1        89
776        1        67
221        1        12
001        1        01


最左列的三位数，应该都是一连号才对，而您代码计算的结果却显示为0连号--这一部分有错误，相对应的，这些都存在连号基数。

应该让连号个数显示为数值格式，以方便求和、平均值及其它统计计算。

玉阳山人

恳请感兴趣的老师们，按附件里的运算规则，帮忙创建个高效、快捷的自定义函数为盼。

yjh_27

玉阳山人 发表于 2019-12-18 18:24
数据源   连号个数   连号基数
443        1        34
566        1        56

参见附件。

玉阳山人

lsdongjh 发表于 2019-12-18 17:28

数据源   连号个数   连号基数
443        1        34
566        1        56
665        1        56
001        1        01
545        1        45
232        1        23
112        1        12
445        1        45
121        1        12
899        1        89
776        1        67
221        1        12
001        1        01


老师：两个问题：
1.上面最左边的三位数，应该都是1连号才对，你看最右边都有连号基数。但您代码计算的结果却显示为0连号--这一部分错了。
2.当第二参数指定为0【或省略】时，应该让连号个数的计算结果显示为数值格式，以方便求和、平均值及其它统计计算。


截图里D:E列青绿色填充之处，就是出错的地方。

玉阳山人

yjh_27 发表于 2019-12-18 23:32
参见附件。

老师：您写的代码已验证，可以显示正确结果。如果第一参数【即数据源】既能指定数据区域，还可以调用单个单元格和直接指定数字，按普通公式输入运算功能就更强大了！
   如：选定D5，输入普通公式 =LIANHAO(A5,0)  或=LIANHAO("192",0) ，即可显示A5或指定数字192的连号个数；
          或选定E5，输入普通公式 =LIANHAO(A5,1)  或=LIANHAO("192",1) ，即可显示A5或指定数字192的连号基数。

麻烦老师给予完善为盼。