[已解决]统计重复上X行的二连码

56899

求各位老师一个函数，如题所述，要求能随意调节统计上X行的二连号码，谢谢！
上附件： 重复上X行几个二连号码.zip (5.4 KB, 下载次数: 27)

2015-10-22 20:51 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2015-10-23 16:49

1. Sub tt()
   
2.     Dim X&
   
3.     arr = Range("d6:m" & [d65536].End(3).Row)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     ReDim brr(1 To UBound(arr), 1 To 1)
   
7.     X = [N4]     '上X行
   
8.     For k = 1 + X To UBound(brr)
   
9.         For i = k - X To k - 1        '上X行
   
10.             For j = 1 To 9     '各列
    
11.                 a = Val(arr(i, j) & arr(i, j + 1))       '二连号
    
12.                 d(a) = ""     '统计上X行所有的二连号，进字典d
    
13.             Next
    
14.         Next
    
15.         
    
16.         For j = 1 To 9     '统计行
    
17.             a = Val(arr(i, j) & arr(i, j + 1))       '二连号
    
18.             If d.exists(a) Then d1(a) = d1(a) + 1 Else d1(a) = 0 '统计行出现上X行出现过的二连号，计数+1
    
19.         Next
    
20.         
    
21.         brr(k, 1) = Application.WorksheetFunction.Sum(d1.items)
    
22.         d.RemoveAll
    
23.         d1.RemoveAll
    
24.     Next
    
25.     [N6].Resize(UBound(arr), 1) = brr
    
26. End Sub

复制代码

跳转到最佳答案楼层

56899

这个函数这么难搞定么？

grf1973

用VBA很好解决。

1. Sub tt()
   
2.     Dim X&
   
3.     arr = Range("d6:m" & [d65536].End(3).Row)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ReDim brr(1 To UBound(arr), 1 To 1)
   
6.     X = [N4]     '上X行
   
7.     For k = 1 + X To UBound(brr)
   
8.         For i = k - X To k - 1        '上X行
   
9.             For j = 1 To 9     '各列
   
10.                 a = Val(arr(i, j) & arr(i, j + 1))       '二连号
    
11.                 d(a) = d(a) + 1      '相同二连号，计数+1
    
12.             Next
    
13.         Next
    
14.         For Each a In d.keys      '计数大于1的二连号，总计数+1
    
15.             If d(a) > 1 Then brr(k, 1) = brr(k, 1) + 1
    
16.         Next
    
17.         d.RemoveAll
    
18.     Next
    
19.     [N6].Resize(UBound(arr), 1) = brr
    
20. End Sub
    

复制代码

56899

grf1973 发表于 2015-10-23 14:49
用VBA很好解决。

谢谢老师！VBA肯定比函数来的容易一些，但重复上X行的算法跟我的要求有出入。能否修改一下吗？

56899

还有一个统计原则没有表述清楚，二连号码要求前后顺序要一致。比如，上一行有57，下一行有75，这种情况是不计的（不算重复）。

grf1973

再解释清楚一点。我是根据你的要求来的。

56899

grf1973 发表于 2015-10-23 16:11
再解释清楚一点。我是根据你的要求来的。

好的 谢谢老师！为了便于理解。我把示例改为只重复上一行的，示例已经重新手工示范，有可能有出入！ 重复上X行几个二连号码.zip (5.45 KB, 下载次数: 2)

2015-10-23 16:16 上传

点击文件名下载附件

grf1973

跟我说说，为什么第7行的上一行有3个？上一行是指第6行，还是指第6+第7行？
另外第7行的4 4 4算不算一个？

56899

因为在N4单元格里已经改为1（意思是就只统计重复上一行），因为上一行D6-M6里有57,64,45，3个二连号码在D7-M7行里又出现了，所以计3个！谢谢老师！

56899

这么理解不知道是否容易些，我不知道VBA语言，用笨办法描述吧。统计上一行，就是下一行与上一行作一比较看看有几个相同的二连号码。先把上一行10个单个数字，分成9个二连号码，然后去掉相同的二连号码（有时因为有两个以上的相同二连，所以要去掉重复号码）