求教如何在VBA中实现SUMIFS的填充

落迟

如图，因为是VBA模块中的一段，不能手动用SUMIFS填充，只能写代码啦，
在VBA中怎么填充到汇总表的所有范围呢？人员与产品数量还会变动，挠破脑袋啦，只好来求教了

huang1314wei

1. Sub test()
   
2.     Dim arr, i%, j%, d
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("A1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         If Not d.exists(arr(i, 1)) Then
   
7.             Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
   
8.         End If
   
9.         d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) + arr(i, 3)
   
10.     Next
    
11.     Erase arr
    
12.     [G2:I1048576].ClearContents
    
13.     arr = Range("F1").CurrentRegion
    
14.     For i = 2 To UBound(arr)
    
15.         For j = 2 To UBound(arr, 2)
    
16.             arr(i, j) = d(arr(i, 1))(arr(1, j))
    
17.         Next
    
18.     Next
    
19.     Range("F1").CurrentRegion = arr
    
20. End Sub

复制代码

huang1314wei

《《《《附件参考》》》》

双条件求和NO1.rar (15.01 KB, 下载次数: 441)

2016-9-6 21:44 上传

点击文件名下载附件

落迟

好厉害，这个我能学一个月

amzxfgh9632

huang1314wei 发表于 2016-9-6 21:44
《《《《附件参考》》》》

谢谢老师分享如果人名、产品能自动生成呢，谢谢

半百

1. Sub 求和()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set D1 = CreateObject("Scripting.Dictionary")
   
4. arr = Range("A1").CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     D1(arr(i, 1)) = ""
   
7.     d(arr(i, 1) & arr(i, 2)) = d(arr(i, 1) & arr(i, 2)) + arr(i, 3)
   
8. Next
   
9. N = D1.Count
   
10. Range("F2").Resize(N, 1) = Application.Transpose(D1.KEYS)
    
11. Range("G1:I1") = Split("产品A,产品B,产品C", ",")
    
12. BRR = Range("F1").Resize(N + 1, 4)
    
13. For i = 2 To N + 1
    
14.     For j = 2 To 4
    
15.         BRR(i, j) = d(BRR(i, 1) & BRR(1, j))
    
16.     Next
    
17. Next
    
18. Range("F1").Resize(N + 1, 4) = BRR
    
19. End Sub
    

复制代码

skyzxh

字典法。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。

1. Sub 求和()
   
2. Dim i&, j&, r&
   
3. Dim arr
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set c1 = CreateObject("Scripting.Dictionary")
   
6. Set c2 = CreateObject("Scripting.Dictionary")
   
7. 
   
8. r = Cells(Rows.Count, 1).End(3).Row
   
9. arr = Range("A2:C" & r)
   
10. For i = 1 To UBound(arr)
    
11.     d(arr(i, 1) & "_" & arr(i, 2)) = d(arr(i, 1) & "_" & arr(i, 2)) + arr(i, 3)
    
12.     c1(arr(i, 1)) = ""
    
13.     c2(arr(i, 2)) = ""
    
14. Next
    
15. y1 = c1.keys
    
16. y2 = c2.keys
    
17. For i = 0 To UBound(y1)
    
18.     Cells(i + 2, 6) = y1(i)
    
19.     For j = 0 To UBound(y2)
    
20.         Cells(1, j + 7) = y2(j)
    
21.         If d.exists(y1(i) & "_" & y2(j)) Then
    
22.             Cells(i + 2, j + 7) = d(y1(i) & "_" & y2(j))
    
23.         End If
    
24.     Next
    
25. Next
    
26. End Sub
    

复制代码

小花鹿

huang1314wei 发表于 2016-9-6 21:43

字典嵌套比较难懂，这样的问题我一般是用三个字典

huang1314wei

小花鹿 发表于 2016-9-6 22:13
字典嵌套比较难懂，这样的问题我一般是用三个字典

实际上这个不难理解，就把d(arr(i, 1))看成一个整体，相当于你常见的字典变量d,只不过这个变量标识是由变量arr(i,1)决定，比如  arr(i,1)="路人甲"  那么此时  d("路人甲")  就是一个字典了，你可以往里面加key  写成变量就是  d(arr(i, 1))(arr(i, 2)) 就是把arr(i,2)装入字典 d(arr(i, 1))

huang1314wei

amzxfgh9632 发表于 2016-9-6 21:58
谢谢老师分享如果人名、产品能自动生成呢，谢谢

用循环输出，无非就是多加个循环，输出方法有很多种的，只不过，提前把人名，产品名列出，赋值的时候更加方便调用