[已解决]如何用vba解决汇总问题

zxmaction

已知前两个数据表，用vba求出需要的结果，谢谢 各位大侠

最佳答案

月排行榜 / 总排行榜

grf1973

2015-12-30 14:25

1. Sub 汇总()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For k = 1 To 2
   
4.         nf = Val(Sheets(k).Name)  '年份
   
5.         arr = Sheets(k).[a1].CurrentRegion
   
6.         For i = 2 To UBound(arr)
   
7.             sf = arr(i, 14)    '省份
   
8.             x = sf & nf & "总件数": d(x) = d(x) + arr(i, 6)     '省份+年份+总件数
   
9.             x = sf & nf & "总金额": d(x) = d(x) + arr(i, 7)         '省份+年份+总金额
   
10.             x = sf & nf & "不重复人数"           '省份+年份+不重复人数
    
11.             y = sf & nf & arr(i, 2)   '省份+年份+客户
    
12.             If Not d.exists(y) Then
    
13.                 d(y) = ""
    
14.                 d(x) = d(x) + 1
    
15.             End If
    
16.         Next
    
17.     Next
    
18.     With Sheets(3)
    
19.         .[b2:p1000].ClearContents
    
20.         r = .[a65536].End(3).Row
    
21.         arr = .Range("a1:q" & r)
    
22.         krr = Array(2, 4, 6, 7, 9, 11)
    
23.         For jj = 0 To UBound(krr)
    
24.             j = krr(jj)
    
25.             For i = 2 To r - 1
    
26.                 x = arr(i, 1) & arr(1, j)
    
27.                 arr(i, j) = d(x)        '各年各省件数、金额、人数
    
28.                 arr(r, j) = arr(r, j) + d(x)        '各省各年总件数、总金额、总人数
    
29.             Next
    
30.         Next
    
31.         For i = 2 To r
    
32.             For j = 2 To UBound(arr, 2) - 1
    
33.                 If j = 3 Or j = 5 Or j = 8 Or j = 10 Then
    
34.                     If arr(i, j - 1) > 0 Then arr(i, j) = arr(i, j - 1) / arr(r, j - 1)         '占比
    
35.                 ElseIf j = 12 Or j = 14 Or j = 16 Then
    
36.                     x = arr(i, j - 5) - arr(i, j - 10)
    
37.                     If x <> 0 Then
    
38.                         arr(i, j) = x      '增减
    
39.                         If arr(i, j - 10) > 0 Then arr(i, j + 1) = x / arr(i, j - 10)        '增减率
    
40.                     End If
    
41.                 End If
    
42.             Next
    
43.         Next
    
44.         .Range("a1:p" & r) = arr
    
45.     End With
    
46. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 汇总()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For k = 1 To 2
   
4.         nf = Val(Sheets(k).Name)  '年份
   
5.         arr = Sheets(k).[a1].CurrentRegion
   
6.         For i = 2 To UBound(arr)
   
7.             sf = arr(i, 14)    '省份
   
8.             x = sf & nf & "总件数": d(x) = d(x) + arr(i, 6)     '省份+年份+总件数
   
9.             x = sf & nf & "总金额": d(x) = d(x) + arr(i, 7)         '省份+年份+总金额
   
10.             x = sf & nf & "不重复人数"           '省份+年份+不重复人数
    
11.             y = sf & nf & arr(i, 2)   '省份+年份+客户
    
12.             If Not d.exists(y) Then
    
13.                 d(y) = ""
    
14.                 d(x) = d(x) + 1
    
15.             End If
    
16.         Next
    
17.     Next
    
18.     With Sheets(3)
    
19.         .[b2:p1000].ClearContents
    
20.         r = .[a65536].End(3).Row
    
21.         arr = .Range("a1:q" & r)
    
22.         krr = Array(2, 4, 6, 7, 9, 11)
    
23.         For jj = 0 To UBound(krr)
    
24.             j = krr(jj)
    
25.             For i = 2 To r - 1
    
26.                 x = arr(i, 1) & arr(1, j)
    
27.                 arr(i, j) = d(x)        '各年各省件数、金额、人数
    
28.                 arr(r, j) = arr(r, j) + d(x)        '各省各年总件数、总金额、总人数
    
29.             Next
    
30.         Next
    
31.         For i = 2 To r
    
32.             For j = 2 To UBound(arr, 2) - 1
    
33.                 If j = 3 Or j = 5 Or j = 8 Or j = 10 Then
    
34.                     If arr(i, j - 1) > 0 Then arr(i, j) = arr(i, j - 1) / arr(r, j - 1)         '占比
    
35.                 ElseIf j = 12 Or j = 14 Or j = 16 Then
    
36.                     x = arr(i, j - 5) - arr(i, j - 10)
    
37.                     If x <> 0 Then
    
38.                         arr(i, j) = x      '增减
    
39.                         If arr(i, j - 10) > 0 Then arr(i, j + 1) = x / arr(i, j - 10)        '增减率
    
40.                     End If
    
41.                 End If
    
42.             Next
    
43.         Next
    
44.         .Range("a1:p" & r) = arr
    
45.     End With
    
46. End Sub

复制代码

zxmaction

grf1973 发表于 2015-12-30 14:25

大侠果然是大侠，十分感谢！有几点疑惑。1：能否当销售数据发生变化时汇总表自动变化，无需按钮。
                                                                   2:2014、2015的销售数据不与汇总表放在一个工作薄中，如何引用？
                                                                   3:如果汇总表中的A列是需要根据销售数据提取其中的不重复省份的名称如何解决

zxmaction

grf1973 发表于 2015-12-30 14:25

请问大侠，我需要加一个条件求某一个品牌的件数、金额不重复人数 需要在哪修改

zxmaction

grf1973 发表于 2015-12-30 14:25

大侠帮忙再看一下，求某一个品牌的数据，需要怎么改动

grf1973

R1 选择品牌，数据自动更新。
至于其他要求，数据源的选择，省份的唯一性，这都不是什么大问题。
如果要结果跟随数据源的改变而改变，也不难，不过不建议这样做，毕竟会占用资源，影响速度。

zxmaction

grf1973 发表于 2016-1-4 09:30
R1 选择品牌，数据自动更新。
至于其他要求，数据源的选择，省份的唯一性，这都不是什么大问题。
如果要结 ...

太棒了 ，谢谢大侠

zxmaction

zxmaction 发表于 2016-1-4 09:45
太棒了 ，谢谢大侠

大侠，由于我需要求出第11列归属那一列自主、非自主的汇总，需要在哪里加条件

zxmaction

grf1973 发表于 2016-1-4 09:30
R1 选择品牌，数据自动更新。
至于其他要求，数据源的选择，省份的唯一性，这都不是什么大问题。
如果要结 ...

大侠，由于我需要求出第11列归属那一列自主、非自主的汇总，需要在哪里加条件

grf1973

请看附件。