[已解决]多条件汇总多项数据

hxgfkfb

Data.rar (7.88 KB, 下载次数: 23)

2016-6-22 16:44 上传

点击文件名下载附件

要求在附件中，谢谢各位老师

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-22 17:06

如果一定要通过VBA，代码如下，但如果只做数据统计用，针对你这个我建议还是用数据透视表！

1. Sub xx()
   
2.     Dim n&, arr, d, brr, i%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.         arr = .Range("B2:H" & n)
   
7.         For i = 1 To n - 1
   
8.             If d.Exists(arr(i, 1) & "|" & arr(i, 3)) Then
   
9.                 d(arr(i, 1) & "|" & arr(i, 3)) = Split(d(arr(i, 1) & "|" & arr(i, 3)), "|")(0) + arr(i, 6) & "|" & Split(d(arr(i, 1) & "|" & arr(i, 3)), "|")(1) + arr(i, 7)
   
10.             Else
    
11.                 d.Add arr(i, 1) & "|" & arr(i, 3), arr(i, 6) & "|" & arr(i, 7)
    
12.             End If
    
13.         Next
    
14.     End With
    
15.     x = 1
    
16.     With Sheet2
    
17.         For Each k In d.keys
    
18.             x = x + 1
    
19.             .Cells(x, 1) = Split(k, "|")(0)
    
20.             .Cells(x, 2) = Split(k, "|")(1)
    
21.             .Cells(x, 3) = Split(d(k), "|")(0)
    
22.             .Cells(x, 4) = Split(d(k), "|")(1)
    
23.         Next
    
24.     End With
    
25. End Sub

复制代码

跳转到最佳答案楼层

爱疯

用数据透视表很方便

老司机带带我

如果一定要通过VBA，代码如下，但如果只做数据统计用，针对你这个我建议还是用数据透视表！

1. Sub xx()
   
2.     Dim n&, arr, d, brr, i%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.         arr = .Range("B2:H" & n)
   
7.         For i = 1 To n - 1
   
8.             If d.Exists(arr(i, 1) & "|" & arr(i, 3)) Then
   
9.                 d(arr(i, 1) & "|" & arr(i, 3)) = Split(d(arr(i, 1) & "|" & arr(i, 3)), "|")(0) + arr(i, 6) & "|" & Split(d(arr(i, 1) & "|" & arr(i, 3)), "|")(1) + arr(i, 7)
   
10.             Else
    
11.                 d.Add arr(i, 1) & "|" & arr(i, 3), arr(i, 6) & "|" & arr(i, 7)
    
12.             End If
    
13.         Next
    
14.     End With
    
15.     x = 1
    
16.     With Sheet2
    
17.         For Each k In d.keys
    
18.             x = x + 1
    
19.             .Cells(x, 1) = Split(k, "|")(0)
    
20.             .Cells(x, 2) = Split(k, "|")(1)
    
21.             .Cells(x, 3) = Split(d(k), "|")(0)
    
22.             .Cells(x, 4) = Split(d(k), "|")(1)
    
23.         Next
    
24.     End With
    
25. End Sub

复制代码