按条件求和，根据 每个部门 统计 月份小计

aellu

把每个部门 的每个月的 小计 进行 求和    。
qiuhe.rar (20.18 KB, 下载次数: 5)

2018-9-7 17:10 上传

点击文件名下载附件

chxw68

1. Sub test4()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d1 = CreateObject("scripting.dictionary")
   
6.   Set d2 = CreateObject("scripting.dictionary")
   
7.   With Worksheets("sheet1")
   
8.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.     arr = .Range("a2:g" & r)
   
10.     For i = 2 To UBound(arr)
    
11.       d1(arr(i, 1)) = i
    
12.     Next
    
13.     For j = 2 To UBound(arr, 2)
    
14.       d2(arr(1, j)) = j
    
15.     Next
    
16.   End With
    
17.   For Each ws In Worksheets
    
18.     If d1.exists(ws.Name) Then
    
19.       m = d1(ws.Name)
    
20.       With ws
    
21.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
22.         brr = .Range("a2:c" & r)
    
23.         s = 0
    
24.         For i = UBound(brr) To 1 Step -1
    
25.           If brr(i, 2) = "小计" Then
    
26.             s = s + brr(i, 3)
    
27.           End If
    
28.           If Len(brr(i, 1)) <> 0 Then
    
29.             If d2.exists(brr(i, 1)) Then
    
30.               n = d2(brr(i, 1))
    
31.               arr(m, n) = s
    
32.             End If
    
33.             s = 0
    
34.           End If
    
35.         Next
    
36.       End With
    
37.     End If
    
38.   Next
    
39.   With Worksheets("sheet1")
    
40.     .Range("a2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
41.   End With
    
42. End Sub
    

复制代码

chxw68

详见附件。