求多条件分类汇总的一段代码

twmly

Book111.rar (6.12 KB, 下载次数: 25)

2016-3-21 11:48 上传

点击文件名下载附件

就是只要Ｂ到Ｆ到的内容是一样的，Ｇ列的数量就相加成一行，结果就希望变成下面黄色的那种样子，

chen7806

透视表，可能会简单一点。

Chip_Kenny

1. Sub zz()
   
2. Dim arr, d As Object, t
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     t = ""
   
7.     For j = 2 To UBound(arr, 2) - 1
   
8.         t = t & "|" & arr(i, j)
   
9.     Next
   
10.     t = Mid(t, 2)
    
11.     If Not d.exists(t) Then
    
12.         d(t) = arr(i, j)
    
13.     Else
    
14.         d(t) = d(t) + arr(i, j)
    
15.     End If
    
16. Next
    
17. k = d.keys: t = d.items
    
18. i = 30
    
19. Cells(i, 1).Resize(1, UBound(arr, 2)) = Application.Index(arr, 1, 0)
    
20. For Each c In k
    
21.     i = i + 1: n = n + 1
    
22.     Cells(i, 1) = n
    
23.     Cells(i, 2).Resize(1, 5) = Split(c, "|")
    
24.     Cells(i, 7) = t(n - 1)
    
25. Next
    
26. End Sub
    

复制代码

LMY123

字典一对多查询或多条件分类汇总