[已解决]求统计个数问题

haeng

请大侠看附件 Book2.rar (2.19 KB, 下载次数: 32)

2011-12-7 15:29 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

snrvgbb

2011-12-7 15:48

1. Sub test()
   
2. Dim arr, i%, k%, Dic, Did, Die
   
3. Set Dic = CreateObject("scripting.dictionary")
   
4. Set Did = CreateObject("scripting.dictionary")
   
5. Set Die = CreateObject("scripting.dictionary")
   
6. arr = Range("a1").CurrentRegion
   
7. For i = 1 To UBound(arr, 2) Step 3
   
8.     For k = 1 To UBound(arr)
   
9.         Dic(arr(k, i)) = Dic(arr(k, i)) + 1
   
10.         Did(arr(k, i + 1)) = Did(arr(k, i + 1)) + 1
    
11.         Die(arr(k, i + 1)) = Die(arr(k, i + 1)) + 1
    
12.     Next
    
13. Next
    
14. Range("a10:f65536").ClearContents
    
15. Range("a10").Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.keys)
    
16. Range("b10").Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.items)
    
17. Range("c10").Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
    
18. Range("d10").Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.items)
    
19. Range("e10").Resize(Die.Count, 1) = WorksheetFunction.Transpose(Die.keys)
    
20. Range("f10").Resize(Die.Count, 1) = WorksheetFunction.Transpose(Die.items)
    
21. End Sub
    

复制代码

跳转到最佳答案楼层

snrvgbb

1. Sub test()
   
2. Dim arr, i%, k%, Dic, Did, Die
   
3. Set Dic = CreateObject("scripting.dictionary")
   
4. Set Did = CreateObject("scripting.dictionary")
   
5. Set Die = CreateObject("scripting.dictionary")
   
6. arr = Range("a1").CurrentRegion
   
7. For i = 1 To UBound(arr, 2) Step 3
   
8.     For k = 1 To UBound(arr)
   
9.         Dic(arr(k, i)) = Dic(arr(k, i)) + 1
   
10.         Did(arr(k, i + 1)) = Did(arr(k, i + 1)) + 1
    
11.         Die(arr(k, i + 1)) = Die(arr(k, i + 1)) + 1
    
12.     Next
    
13. Next
    
14. Range("a10:f65536").ClearContents
    
15. Range("a10").Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.keys)
    
16. Range("b10").Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.items)
    
17. Range("c10").Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
    
18. Range("d10").Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.items)
    
19. Range("e10").Resize(Die.Count, 1) = WorksheetFunction.Transpose(Die.keys)
    
20. Range("f10").Resize(Die.Count, 1) = WorksheetFunction.Transpose(Die.items)
    
21. End Sub
    

复制代码

haeng

snrvgbb 发表于 2011-12-7 15:48

谢谢你,让我节省了很多时间