多条件求和

彭庆伟

cjc209 发表于 2023-3-1 16:20
Sub 过程名()
    Dim dic
    Set dic = CreateObject("scripting.dictionary")

纯小白，没太看懂

彭庆伟

ykcbf1100 发表于 2023-3-1 16:21
请参考附件。。。

数据源B列=Y这个条件好像没有生效啊

彭庆伟

半百 发表于 2023-3-1 16:32

谢谢大佬，受教了

彭庆伟

tanglf188 发表于 2023-3-1 17:24
看看结果对吗？对就传代码。

对的，能帮忙代码加个注释吗，我也想学习下，谢谢！

彭庆伟

清风竹- 发表于 2023-3-1 16:46
请看附件。

每次统计，好像把结果累加了，想要统计的时候，只根据数据源里面的数据统计，也就是数据源里面的实时数据是多少，结果就是多少，不累计叠加，谢谢！

ykcbf1100

彭庆伟 发表于 2023-3-2 08:23
数据源B列=Y这个条件好像没有生效啊

和8楼的结果完全一样的，哪里有问题了？

清风竹-

彭庆伟 发表于 2023-3-2 08:27
每次统计，好像把结果累加了，想要统计的时候，只根据数据源里面的数据统计，也就是数据源里面的实时数据 ...

已修改。。

tanglf188

全党

参与一下，才学VBA，见笑了。

1. Sub shishi()
   
2.     Dim arr, d
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.         arr = Worksheets("数据源").Range("a1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         If arr(i, 2) = "Y" Then
   
7.             k = arr(i, 1): k1 = arr(i, 3): k2 = arr(i, 4)
   
8.             d(k & k1) = d(k & k1) + arr(i, 5)
   
9.             d(k2 & k1) = d(k2 & k1) + arr(i, 5)
   
10.         End If
    
11.     Next
    
12. 
    
13.     With Worksheets("统计表")
    
14.       For i = 2 To 6
    
15.           For j = 4 To 16
    
16.             If .Cells(j, 1) <> "" Then
    
17.              If d.exists(.Cells(j, 1) & .Cells(1, i)) Then
    
18.                  .Cells(j, i) = d(.Cells(j, 1) & .Cells(1, i))
    
19.             End If
    
20.             End If
    
21.           Next
    
22.       Next
    
23.     End With
    
24.    
    
25. End Sub

复制代码