[已解决]VBA多条件求和问题

weiruikui

各位哥哥姐姐：
     小妹在一公司财务做成本核算工作，每天的数据统计量非常大。目前在多件件求和的问题下都是采用函数，但非常慢，有时还会造成死机出现。小妹实在是没有办法了，只好求教哥哥姐姐弟弟妹妹们，如能得到各位哥哥姐姐弟弟妹妹们的帮助不胜感激！
    我遇到的问题是这样的：
     表（一）
    A列 （部门）   B列 （物料名称）     C列（领料数量）
      制造二部           纸箱                          15
      制造一部           白纸                           5
      制造二部           白纸                           5
      制造二部           纸箱                          30
      制造一部           纸箱                           5
      制造一部           白纸                           19
   统计结果放在表（二）的C列
      A列 （部门）   B列 （物料名称）     C列（领料数量）
      制造一部           白纸
      制造一部           纸箱
      制造二部           白纸
      制造二部           纸箱

最佳答案

月排行榜 / 总排行榜

风林火山

2014-1-9 17:59

重复发帖

1. 
   
2. <P>Sub test()
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Dim k%, i%, m%, str$, str1$</P>
   
6. <P>    arr = Sheets("sheet1").Range("a1").CurrentRegion
   
7.     brr = Sheets("sheet2").Range("a1").CurrentRegion
   
8.     Set d = CreateObject("scripting.dictionary")</P>
   
9. <P>    For k = 2 To UBound(arr)
   
10.         str = arr(k, 1) & arr(k, 2)
    
11.         If Not d.exists(str) Then
    
12.             d(str) = arr(k, 3)
    
13.         Else
    
14.             d(str) = d(str) + arr(k, 3)
    
15.         End If
    
16.     Next k
    
17.     For i = 2 To UBound(brr)
    
18.             str1 = brr(i, 1) & brr(i, 2)
    
19.             brr(i, 3) = d(str1)
    
20.     Next i</P>
    
21. <P>    Sheets("sheet2").Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
22. End Sub
    
23. </P>

复制代码

跳转到最佳答案楼层

风林火山

重复发帖

1. 
   
2. <P>Sub test()
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Dim k%, i%, m%, str$, str1$</P>
   
6. <P>    arr = Sheets("sheet1").Range("a1").CurrentRegion
   
7.     brr = Sheets("sheet2").Range("a1").CurrentRegion
   
8.     Set d = CreateObject("scripting.dictionary")</P>
   
9. <P>    For k = 2 To UBound(arr)
   
10.         str = arr(k, 1) & arr(k, 2)
    
11.         If Not d.exists(str) Then
    
12.             d(str) = arr(k, 3)
    
13.         Else
    
14.             d(str) = d(str) + arr(k, 3)
    
15.         End If
    
16.     Next k
    
17.     For i = 2 To UBound(brr)
    
18.             str1 = brr(i, 1) & brr(i, 2)
    
19.             brr(i, 3) = d(str1)
    
20.     Next i</P>
    
21. <P>    Sheets("sheet2").Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
22. End Sub
    
23. </P>

复制代码

weiruikui

新手上路啦，不懂啦。不好意思啦。

cxl1973

表2的c2输入=SUMPRODUCT((Sheet1!B$2:B$7=Sheet2!B2)*1,(Sheet1!$A$2:$A$7=Sheet2!A2)*1,Sheet1!$C$2:$C$7),数组公式下拉！