对数据源表中相同条件的金额求和汇总到模版表中

32244

现有2张数据源表，需要对数据源中相同城市，相同项目的条目金额求和，汇总到模版表当中。

扑腾

结果未曾验证，不知道是否可行

1. Sub 汇总()
   
2.     pth = ThisWorkbook.Path & ""
   
3.     f = Dir(pth & "*.xlsx")
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Application.ScreenUpdating = False
   
6.     Do While f <> ""
   
7.         If f <> ThisWorkbook.Name Then
   
8.             Set wb = Workbooks.Open(f)
   
9.                 With wb.Sheets(1)
   
10.                     arr = .[b9].CurrentRegion
    
11.                         For i = 3 To UBound(arr)
    
12.                         y = arr(i, 1) & "," & arr(i, 2)
    
13.                         d(y) = d(y) + arr(i, 4)
    
14.                     Next
    
15.                 End With
    
16.             wb.Close
    
17.         End If
    
18.         f = Dir
    
19.     Loop
    
20.     Application.ScreenUpdating = True
    
21.     ThisWorkbook.Worksheets(1).[a7].Resize(d.Count) = Application.Transpose(d.keys)
    
22.     ThisWorkbook.Worksheets(1).[a7].Resize(d.Count).TextToColumns comma:=True
    
23.     ThisWorkbook.Worksheets(1).[d7].Resize(d.Count) = Application.Transpose(d.items)
    
24. End Sub
    

复制代码

32244

扑腾 发表于 2019-3-16 15:28
结果未曾验证，不知道是否可行

提示找不到数据源1。。

扑腾

可能是我这边系统把文件破坏了，你可以把代码复制到你的原始附件运行。

扑腾

32244 发表于 2019-3-16 16:05
提示找不到数据源1。。

或者将Set wb = Workbooks.Open(f)改为Set wb = Workbooks.Open(pth & f)试试

32244

扑腾 发表于 2019-3-16 16:33
或者将Set wb = Workbooks.Open(f)改为Set wb = Workbooks.Open(pth & f)试试

谢谢大佬。。

32244

扑腾 发表于 2019-3-16 16:33
或者将Set wb = Workbooks.Open(f)改为Set wb = Workbooks.Open(pth & f)试试

第三列做不出啊