根据品种金额明细表和品种大类映射表求大类金额合计

rogerbbcc

请教大神，已知一张各品种销售金额的明细表，能否通过另外一张品种和所归属大类的映射表得出大类的销售合计，能否直接通过内存数组而不使用辅助列直接计算出结果，具体例题见附件。

rogerbbcc

发错板块了，不知道怎么删除，请版主帮忙删帖。

鄂龙蒙

1. Sub 统计()
   
2.     Dim arr, brr
   
3.     Dim m, i, j, x, k, t
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     [B18:G20] = Empty
   
7.     arr = Range("I2:J12")
   
8.     For i = 2 To UBound(arr)
   
9.          If Not d.exists(arr(i, 2)) Then
   
10.             m = 1
    
11.             ReDim brr(1 To 1, 1 To m)
    
12.         Else
    
13.             brr = d(arr(i, 2))
    
14.             m = UBound(brr, 2) + 1
    
15.             ReDim Preserve brr(1 To 1, 1 To m)
    
16.         End If
    
17.         brr(1, m) = arr(i, 1)
    
18.         d(arr(i, 2)) = brr
    
19.     Next
    
20.     k = d.keys
    
21.     t = d.items
    
22.     arr = Range("A1:G14")
    
23.     For i = 2 To UBound(arr)
    
24.         For x = 0 To d.Count - 1
    
25.             For j = 1 To UBound(t(x), 2)
    
26.                 If arr(i, 1) = t(x)(1, j) Then arr(i, 1) = k(x)
    
27.             Next
    
28.         Next
    
29.     Next
    
30.     d.RemoveAll
    
31.     For i = 2 To UBound(arr)
    
32.         For j = 2 To UBound(arr, 2)
    
33.             d(arr(i, 1) & arr(1, j)) = d(arr(i, 1) & arr(1, j)) + arr(i, j)
    
34.         Next
    
35.     Next
    
36.     arr = Range("A17:G20")
    
37.     For i = 2 To UBound(arr)
    
38.         For j = 2 To UBound(arr, 2)
    
39.             arr(i, j) = d(arr(i, 1) & arr(1, j))
    
40.         Next
    
41.     Next
    
42.     Range("A17").Resize(UBound(arr), UBound(arr, 2)) = arr
    
43.     Set d = Nothing
    
44. End Sub

复制代码

yanglinzi

这个是不是你要的结果