[已解决]请求帮忙 ：自动分类汇总

lokisandra

完全是新手，请大家帮忙。
有拜读论坛里很多资料 ，但是实在不太懂 。

1. 就是需要把客户对应的金额统计，然后在不同的sheet“结果”上 输出结果。需要 在结果sheet上显示标题如“客户”，“总金额”。

2. 此外，如果只要显示总金额超过 800的客户以及其对应总金额 ，应该如何编写？

附上 附件。请各位大人帮帮忙。感激不尽！！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-5-22 14:31

严谨一点应该这样

1. Sub ttt()         '不用字典
   
2.     arr = [a3].CurrentRegion
   
3.     ReDim brr(UBound(arr), 1 To 2)
   
4.     brr(0, 1) = "客户": brr(0, 2) = "总金额"
   
5.     xmin = Val([g2])
   
6.     x = ","        '已统计过的客户名单
   
7.     For i = 2 To UBound(arr)
   
8.         kh = arr(i, 2)      '客户名
   
9.         If InStr(x, "," & arr(i, 2) & ",") = 0 Then        '表示该客户未被统计过
   
10.             x = x & kh & ","        '加入已统计名单
    
11.             zje = Application.WorksheetFunction.SumIf([b:b], kh, [c:c])      '该客户的总金额
    
12.             If zje >= xmin Then
    
13.                 n = n + 1
    
14.                 brr(n, 1) = kh
    
15.                 brr(n, 2) = zje
    
16.             End If
    
17.         End If
    
18.     Next
    
19.         
    
20.     With Sheet2
    
21.         .Activate
    
22.         .Cells.Clear
    
23.         If n > 0 Then
    
24.             .[a1].Resize(n + 1, 2) = brr
    
25.             .[a2].Resize(n, 2).Sort key1:=.[a2]
    
26.         End If
    
27.     End With
    
28. End Sub
    

复制代码

区别在第9行，考虑到某客户名中包含另一客户名的情况。

跳转到最佳答案楼层

baksy

想要什么样的结果？请模拟一下。

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a3].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 2)) = d(arr(i, 2)) + arr(i, 3)
   
6.     Next
   
7.     ReDim brr(UBound(arr), 1 To 2)
   
8.     brr(0, 1) = "客户": brr(0, 2) = "总金额"
   
9.     xmin = Val([g2])
   
10.     For Each k In d.keys
    
11.         If d(k) >= xmin Then
    
12.             n = n + 1
    
13.             brr(n, 1) = k
    
14.             brr(n, 2) = d(k)
    
15.         End If
    
16.     Next
    
17.     Sheet2.Activate
    
18.     Sheet2.Cells.Clear
    
19.     If n > 0 Then Sheet2.[a1].Resize(n + 1, 2) = brr
    
20. End Sub
    

复制代码

grf1973

..............

lokisandra

grf1973 发表于 2015-5-22 13:37

谢谢 。 但是 如果 要求只是 显示 总金额 超过 800的 呢？
并且按照 客户 名字 排序 ？
再次感谢 。

lokisandra

grf1973 发表于 2015-5-22 13:38
..............

太谢谢了！！

grf1973

[g2]单元格改成800.
加上排序的代码：

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a3].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 2)) = d(arr(i, 2)) + arr(i, 3)
   
6.     Next
   
7.     ReDim brr(UBound(arr), 1 To 2)
   
8.     brr(0, 1) = "客户": brr(0, 2) = "总金额"
   
9.     xmin = Val([g2])
   
10.     For Each k In d.keys
    
11.         If d(k) >= xmin Then
    
12.             n = n + 1
    
13.             brr(n, 1) = k
    
14.             brr(n, 2) = d(k)
    
15.         End If
    
16.     Next
    
17.     With Sheet2
    
18.         .Activate
    
19.         .Cells.Clear
    
20.         If n > 0 Then
    
21.             .[a1].Resize(n + 1, 2) = brr
    
22.             .[a2].Resize(n, 2).Sort key1:=.[a2]
    
23.         End If
    
24.     End With
    
25. End Sub
    

复制代码

lokisandra

grf1973 发表于 2015-5-22 13:50
[g2]单元格改成800.
加上排序的代码：

万分感谢！！完全解决我燃眉之急。

再追加一个问题，如果不用 Set dic = CreateObject("Scripting.Dictionary") 这种类型的，有没有其它方法可以做到相同的要求？比如先排序客户名字 之类的？

grf1973

分类汇总用字典最方便快捷。按你要求给个没用字典的代码，用字符串x标记已统计过的客户，用sumif统计总金额，并提取大于800的数据。

1. Sub ttt()         '不用字典
   
2.     arr = [a3].CurrentRegion
   
3.     ReDim brr(UBound(arr), 1 To 2)
   
4.     brr(0, 1) = "客户": brr(0, 2) = "总金额"
   
5.     xmin = Val([g2])
   
6.     x = ","        '已统计过的客户名单
   
7.     For i = 2 To UBound(arr)
   
8.         kh = arr(i, 2)      '客户名
   
9.         If InStr(x, kh) = 0 Then        '表示该客户未被统计过
   
10.             x = x & kh & ","        '加入已统计名单
    
11.             zje = Application.WorksheetFunction.SumIf([b:b], kh, [c:c])      '该客户的总金额
    
12.             If zje >= xmin Then
    
13.                 n = n + 1
    
14.                 brr(n, 1) = kh
    
15.                 brr(n, 2) = zje
    
16.             End If
    
17.         End If
    
18.     Next
    
19.         
    
20.     With Sheet2
    
21.         .Activate
    
22.         .Cells.Clear
    
23.         If n > 0 Then
    
24.             .[a1].Resize(n + 1, 2) = brr
    
25.             .[a2].Resize(n, 2).Sort key1:=.[a2]
    
26.         End If
    
27.     End With
    
28. End Sub
    

复制代码

grf1973

严谨一点应该这样

1. Sub ttt()         '不用字典
   
2.     arr = [a3].CurrentRegion
   
3.     ReDim brr(UBound(arr), 1 To 2)
   
4.     brr(0, 1) = "客户": brr(0, 2) = "总金额"
   
5.     xmin = Val([g2])
   
6.     x = ","        '已统计过的客户名单
   
7.     For i = 2 To UBound(arr)
   
8.         kh = arr(i, 2)      '客户名
   
9.         If InStr(x, "," & arr(i, 2) & ",") = 0 Then        '表示该客户未被统计过
   
10.             x = x & kh & ","        '加入已统计名单
    
11.             zje = Application.WorksheetFunction.SumIf([b:b], kh, [c:c])      '该客户的总金额
    
12.             If zje >= xmin Then
    
13.                 n = n + 1
    
14.                 brr(n, 1) = kh
    
15.                 brr(n, 2) = zje
    
16.             End If
    
17.         End If
    
18.     Next
    
19.         
    
20.     With Sheet2
    
21.         .Activate
    
22.         .Cells.Clear
    
23.         If n > 0 Then
    
24.             .[a1].Resize(n + 1, 2) = brr
    
25.             .[a2].Resize(n, 2).Sort key1:=.[a2]
    
26.         End If
    
27.     End With
    
28. End Sub
    

复制代码

区别在第9行，考虑到某客户名中包含另一客户名的情况。