VBA字典法多条件求和

elon23

各位大神，我现在需要进行多条件求和并填入每一行的单元格中，原来是用SUMIFS公式下拉，但是数据量较大，用SUMIFS效率很慢，请大神帮写个VBA代码，谢谢。

cbtaja

直接用数据透视表应该可以满足你的要求： 多条件求和.rar (11.95 KB, 下载次数: 9)

2017-6-28 10:16 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("结果")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:d" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       xm = arr(i, 1) & "+" & arr(i, 3)
    
11.       If InStr(arr(i, 2), "强制") <> 0 Then
    
12.         d(xm) = d(xm) + arr(i, 4)
    
13.       End If
    
14.     Next
    
15.     ReDim brr(1 To UBound(arr), 1 To 1)
    
16.     For i = 1 To UBound(arr)
    
17.       xm = arr(i, 1) & "+" & arr(i, 3)
    
18.       If d.exists(xm) Then
    
19.         brr(i, 1) = d(xm)
    
20.       End If
    
21.     Next
    
22.     .Range("e2").Resize(UBound(brr), 1) = brr
    
23.   End With
    
24. End Sub
    

复制代码

chxw68

详见附件。

grf1973

看见这种非常规范的二维表，总是忍不住想用Ado练练手。

elon23

chxw68 发表于 2017-6-28 10:18
详见附件。

又是大神，谢谢！！！

wds1061

收藏学习！谢谢分享

wds1061

chxw68 发表于 2017-6-28 10:18

老师方便给代码写个注释吗？谢谢了

绿色心情小天使

wds1061 发表于 2017-6-28 12:26
老师方便给代码写个注释吗？谢谢了

同问，代码注解

today0427

老师唤我来做题哈哈哈……