求助，多条件统计汇总VBA代码

cfjh426

求助，多条件统计汇总，具体见附件表格，主要是将sheet1总的数据根据条件和格式汇总到sheet2中，我自己通过VBA的CountIfs函数实现了，但是效率较低，执行完毕需要6分钟，实在是太慢了，求助高手有没有效率更高的方案呢，谢谢啦

ykqrs

1. Sub qq()
   
2. Dim d, arr, r%, i%, j%, s$, t
   
3. t = Timer
   
4. r = Cells(Rows.Count, 1).End(xlUp).Row
   
5. arr = Range("a2:b" & r)
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. For i = 1 To UBound(arr)
   
8. d(arr(i, 1) & arr(i, 2)) = d(arr(i, 1) & arr(i, 2)) + 1
   
9. Next
   
10. With Sheets("结果")
    
11. arr = .[a1].CurrentRegion
    
12. For i = 2 To UBound(arr)
    
13. For j = 2 To UBound(arr, 2)
    
14. s = arr(i, 1) & arr(1, j)
    
15. If d.exists(s) Then
    
16. arr(i, j) = d(s)
    
17. Else
    
18. arr(i, j) = 0
    
19. End If
    
20. Next
    
21. Next
    
22. .[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
23. End With
    
24. MsgBox "完成用时" & Format(Timer - t, "0.00")
    
25. End Sub
    

复制代码

ykqrs

求助.rar (349.2 KB, 下载次数: 212)

2018-8-25 14:15 上传

点击文件名下载附件

cfjh426

谢谢大佬，运行速度飞起来了，以后我要补习一下字典了