[已解决]搞不定请帮我看下这个代码咋写

陈希琦

请问如何通过字典的方式让sheet(原始数据)里的内容自动统计并输出到sheet(数据输出）里，万分感谢，我目前也在学习VBA，但是是个新手，搞不定阿

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2016-8-19 12:11

1. Sub XXX()
   
2. Dim arr, Dic, brr, xrr
   
3. arr = Sheet1.[a1].CurrentRegion
   
4. Set Dic = CreateObject("scripting.dictionary")
   
5. For a = 1 To UBound(arr)
   
6.     brr = Application.Index(arr, a, 0)
   
7.     If Not Dic.exists(arr(a, 1) & arr(a, 2)) Then
   
8.         Dic(arr(a, 1) & arr(a, 2)) = brr
   
9.     Else
   
10.         xrr = Dic(arr(a, 1) & arr(a, 2))
    
11.         For b = 3 To UBound(brr)
    
12.             xrr(b) = xrr(b) + brr(b)
    
13.         Next
    
14.         Dic(arr(a, 1) & arr(a, 2)) = xrr
    
15.     End If
    
16. Next
    
17. Sheet2.[a1].Resize(Dic.Count, UBound(xrr)) = Application.Transpose(Application.Transpose(Dic.items()))
    
18. End Sub

复制代码

跳转到最佳答案楼层

gufengaoyue

1. Sub XXX()
   
2. Dim arr, Dic, brr, xrr
   
3. arr = Sheet1.[a1].CurrentRegion
   
4. Set Dic = CreateObject("scripting.dictionary")
   
5. For a = 1 To UBound(arr)
   
6.     brr = Application.Index(arr, a, 0)
   
7.     If Not Dic.exists(arr(a, 1) & arr(a, 2)) Then
   
8.         Dic(arr(a, 1) & arr(a, 2)) = brr
   
9.     Else
   
10.         xrr = Dic(arr(a, 1) & arr(a, 2))
    
11.         For b = 3 To UBound(brr)
    
12.             xrr(b) = xrr(b) + brr(b)
    
13.         Next
    
14.         Dic(arr(a, 1) & arr(a, 2)) = xrr
    
15.     End If
    
16. Next
    
17. Sheet2.[a1].Resize(Dic.Count, UBound(xrr)) = Application.Transpose(Application.Transpose(Dic.items()))
    
18. End Sub

复制代码

陈希琦

可能是我没有说清楚，原始数据里的A列是时间，B列是人名，C1:G1是不同类型，下面的数字是不同类型的数量，比如在8月1日张出现了3次，钱出现2次，然后在数据输出里统计8月1日张、钱不同类型的总数量，我看你这个代码跑出来的，在数据输出表里钱还是出现2次，并不是1次。

su45

没细看吧，代码的结果与你的结果完全一样呀！

陈希琦

gufengaoyue 发表于 2016-8-19 12:11

万分感谢

su45

看了，二楼的代码没错呀，你再细看下。