[已解决]请教统计问题

yvll

请教统计问题，谢谢！
统计.rar (10.04 KB, 下载次数: 9)

2016-12-6 13:21 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-12-7 08:32

显示位置也一并调好了。

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     n = [t1]   '行数
   
4.     xrr = Range("k4:o" & [k65536].End(3).Row)    '源数据
   
5.     ReDim yrr(n To UBound(xrr), 1 To UBound(xrr, 2))     '显示结果
   
6.    
   
7.     For j = 1 To UBound(xrr, 2)   '各列
   
8.         For k = n To UBound(xrr)      '从指定行开始
   
9.             p = xrr(k, j)      '特定数
   
10.             For i = k - 1 To k - n + 1 Step -1
    
11.                 If xrr(i, j) = p Then d(xrr(i + 1, j)) = d(xrr(i + 1, j)) + 1
    
12.             Next
    
13.             
    
14.             If d.Count > 1 Then
    
15.                 ReDim brr(1 To Application.Max(d.items))
    
16.                 For kk = 0 To 9    'key从小到大
    
17.                     x = d(kk)
    
18.                     If x > 0 Then brr(x) = brr(x) & kk
    
19.                 Next
    
20.                
    
21.                 For i = UBound(brr) To 1 Step -1  '出现次数从大到小
    
22.                     yrr(k, j) = yrr(k, j) & brr(i)
    
23.                 Next
    
24.                 d.RemoveAll
    
25.             End If
    
26.         Next
    
27.     Next
    
28.     [q123].Resize(UBound(yrr) - n + 1, UBound(yrr, 2)) = yrr
    
29. End Sub
    

复制代码

grf1973

显示位置什么的自己调一下吧。

yvll

grf1973 发表于 2016-12-6 15:50
显示位置什么的自己调一下吧。

非常感谢您，非常好，通过数据验算非常准确，老师您如有时间，请将以下功能加上，非常感谢。
如果T1中不填数字，则统计仍从K123、L123、M123、N123、O123开始，分别到K4、L4、M4、N4、O4，而K123、L123、M123、N123、O123其后各单元格也是统计到K4、L4、M4、N4、O4。

grf1973

显示位置也一并调好了。

yvll

grf1973 发表于 2016-12-7 08:32
显示位置也一并调好了。

太好了，太完美了，衷心地感谢您！