关于类别汇总

wiljn

在【 细类月 】表a列是小类代码和名称【小类月】表中为小类，它的编码为细类编码前6位

【中类月】表中为中类，它的编码为细类编码前4位
现在细类编码都有实收金额数据，希望大神帮我汇总一下到【小类月】和【中类月】中，谢谢啦。

wdx223

1. =SUMPRODUCT((LEFT($A3,4)=LEFT(细类月!$A$3:$A$61,4))*细类月!B$3:B$61)

复制代码

wdx223

1. =SUMPRODUCT((LEFT($A3,6)=LEFT(细类月!$A$3:$A$61,6))*细类月!B$3:B$61)

复制代码

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr(), brr
   
4.   Dim d() As Object
   
5.   vs = [{"中类月",4;"小类月",6}]
   
6.   ReDim arr(1 To UBound(vs))
   
7.   ReDim d(1 To 2)
   
8.   For k = 1 To 2
   
9.     Set d(k) = CreateObject("scripting.dictionary")
   
10.   Next
    
11.   For k = 1 To UBound(vs)
    
12.     With Worksheets(vs(k, 1))
    
13.       r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
14.       .Range("b3:d" & r).ClearContents
    
15.       arr(k) = .Range("a3:d" & r)
    
16.       For i = 1 To UBound(arr(k))
    
17.         If Left(arr(k)(i, 1), 1) Like "[0-9]" Then
    
18.           bm = Left(arr(k)(i, 1), vs(k, 2))
    
19.           d(k)(bm) = i
    
20.         End If
    
21.       Next
    
22.     End With
    
23.   Next
    
24.   With Worksheets("细类月")
    
25.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
26.     brr = .Range("a3:d" & r)
    
27.     For i = 1 To UBound(brr)
    
28.       For k = 1 To UBound(vs)
    
29.         bm = Left(brr(i, 1), vs(k, 2))
    
30.         If d(k).exists(bm) Then
    
31.           m = d(k)(bm)
    
32.           For j = 2 To 4
    
33.             arr(k)(m, j) = arr(k)(m, j) + brr(i, j)
    
34.           Next
    
35.         End If
    
36.       Next
    
37.     Next
    
38.   End With
    
39.   For k = 1 To UBound(vs)
    
40.     With Worksheets(vs(k, 1))
    
41.       .Range("a3").Resize(UBound(arr(k)), UBound(arr(k), 2)) = arr(k)
    
42.     End With
    
43.   Next
    
44. End Sub
    

复制代码

chxw68

详见附件。

wiljn

谢谢大家的帮忙