[已解决]数据统计

cyj153

相同数据统计.rar (18.49 KB, 下载次数: 28)

2015-11-24 11:27 上传

点击文件名下载附件 ，谢 谢大家！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-11-24 20:19

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet2.Range("a1").CurrentRegion
   
5. ReDim brr(1 To 2000, 1 To 7)
   
6. For i = 2 To UBound(arr)
   
7.     If Not d.exists(arr(i, 4)) Then
   
8.         s = s + 1
   
9.         d(arr(i, 4)) = s
   
10.         brr(s, 1) = arr(i, 4)
    
11.         brr(s, 2) = arr(i, 6)
    
12.         brr(s, 3) = arr(i, 2)
    
13.         brr(s, 4) = arr(i, 2)
    
14.         If arr(i, 5) = "男" Then brr(s, 5) = 1 Else brr(s, 6) = 1
    
15.         brr(s, 7) = 1
    
16.     Else
    
17.         n = d(arr(i, 4))
    
18.         brr(n, 4) = arr(i, 2)
    
19.         If arr(i, 5) = "男" Then brr(n, 5) = brr(n, 5) + 1 Else brr(n, 6) = brr(n, 6) + 1
    
20.         brr(n, 7) = brr(s, 7) + 1
    
21.     End If
    
22. Next
    
23. Sheet3.Range("a2").Resize(s, 7) = brr
    
24. End Sub

复制代码

跳转到最佳答案楼层

爱疯

用数据透视表方便些，一会儿就能自己完成。
不过，我不会把起始号码，终止号码和性别，在数据透视表里做在一起。
只好这样复制到一起，看可以吗

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet2.Range("a1").CurrentRegion
   
5. ReDim brr(1 To 2000, 1 To 7)
   
6. For i = 2 To UBound(arr)
   
7.     If Not d.exists(arr(i, 4)) Then
   
8.         s = s + 1
   
9.         d(arr(i, 4)) = s
   
10.         brr(s, 1) = arr(i, 4)
    
11.         brr(s, 2) = arr(i, 6)
    
12.         brr(s, 3) = arr(i, 2)
    
13.         brr(s, 4) = arr(i, 2)
    
14.         If arr(i, 5) = "男" Then brr(s, 5) = 1 Else brr(s, 6) = 1
    
15.         brr(s, 7) = 1
    
16.     Else
    
17.         n = d(arr(i, 4))
    
18.         brr(n, 4) = arr(i, 2)
    
19.         If arr(i, 5) = "男" Then brr(n, 5) = brr(n, 5) + 1 Else brr(n, 6) = brr(n, 6) + 1
    
20.         brr(n, 7) = brr(s, 7) + 1
    
21.     End If
    
22. Next
    
23. Sheet3.Range("a2").Resize(s, 7) = brr
    
24. End Sub

复制代码

雄鹰2013

dsmch 发表于 2015-11-24 20:19

dsmch 老师，好久没见你答题了