[已解决]如何提取不重复的客户销售汇总

zxmaction

根据销售明细，如何在另一个工作表提取不重复客户的销售数据

最佳答案

月排行榜 / 总排行榜

sry660

2015-12-14 00:21

1. Sub 提取不重复值并汇总()
   
2. Dim arr
   
3. Sheets(1).Activate
   
4. arr = [a1].CurrentRegion
   
5. 
   
6. Dim d, d1, x$, y$, i&
   
7. Set d = CreateObject("scripting.dictionary")
   
8. Set d1 = CreateObject("scripting.dictionary")
   
9. For i = 2 To UBound(arr)
   
10.     x = arr(i, 1): y = arr(i, 2)
    
11.     d1(x) = ""
    
12.     If Not d.exists(x) Then Set d(x) = CreateObject("scripting.dictionary")
    
13.     d(x)(y) = d(x)(y) + arr(i, 3)
    
14. Next
    
15. Sheets(2).[a:h].ClearContents
    
16. Sheets(2).[a1].Resize(1, 4) = Array("客户", "百事", "可口", "芬达")
    
17. Sheets(2).[a2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    
18. 
    
19. Dim brr, j&, k&
    
20. brr = Sheets(2).[a1].CurrentRegion
    
21. For j = 2 To UBound(brr)
    
22.     For k = 2 To UBound(brr, 2)
    
23.         If d(brr(j, 1)).exists(brr(1, k)) Then
    
24.             brr(j, k) = d(brr(j, 1))(brr(1, k))
    
25.         Else
    
26.             brr(j, k) = 0
    
27.         End If
    
28.     Next k
    
29. Next j
    
30. 
    
31. Sheets(2).[a1].CurrentRegion = brr
    
32. Set d = Nothing
    
33. Set d1 = Nothing
    
34. Erase arr, brr
    
35. Sheets(2).Select
    
36. [a:d].EntireColumn.AutoFit
    
37. 
    
38. End Sub

复制代码

跳转到最佳答案楼层

baksy

附件

yeminqiang

销售数据.zip (8.62 KB, 下载次数: 8)

2015-12-13 21:17 上传

点击文件名下载附件

zxmaction

baksy 发表于 2015-12-13 21:01
附件

要是sheet1中的客户数量增加怎么办

sry660

1. Sub 提取不重复值并汇总()
   
2. Dim arr
   
3. Sheets(1).Activate
   
4. arr = [a1].CurrentRegion
   
5. 
   
6. Dim d, d1, x$, y$, i&
   
7. Set d = CreateObject("scripting.dictionary")
   
8. Set d1 = CreateObject("scripting.dictionary")
   
9. For i = 2 To UBound(arr)
   
10.     x = arr(i, 1): y = arr(i, 2)
    
11.     d1(x) = ""
    
12.     If Not d.exists(x) Then Set d(x) = CreateObject("scripting.dictionary")
    
13.     d(x)(y) = d(x)(y) + arr(i, 3)
    
14. Next
    
15. Sheets(2).[a:h].ClearContents
    
16. Sheets(2).[a1].Resize(1, 4) = Array("客户", "百事", "可口", "芬达")
    
17. Sheets(2).[a2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    
18. 
    
19. Dim brr, j&, k&
    
20. brr = Sheets(2).[a1].CurrentRegion
    
21. For j = 2 To UBound(brr)
    
22.     For k = 2 To UBound(brr, 2)
    
23.         If d(brr(j, 1)).exists(brr(1, k)) Then
    
24.             brr(j, k) = d(brr(j, 1))(brr(1, k))
    
25.         Else
    
26.             brr(j, k) = 0
    
27.         End If
    
28.     Next k
    
29. Next j
    
30. 
    
31. Sheets(2).[a1].CurrentRegion = brr
    
32. Set d = Nothing
    
33. Set d1 = Nothing
    
34. Erase arr, brr
    
35. Sheets(2).Select
    
36. [a:d].EntireColumn.AutoFit
    
37. 
    
38. End Sub

复制代码

baksy

zxmaction 发表于 2015-12-13 21:46
要是sheet1中的客户数量增加怎么办

调整公式中的取值范围33即可。

zxmaction

baksy 发表于 2015-12-14 06:53
调整公式中的取值范围33即可。

还是不行，怎么回事？

zxmaction

sry660 发表于 2015-12-14 00:21

真好用！但是不懂