求一段多条件求和汇总代码,数据量大不想用公式公式解决

cnmlgb9998

这种问题，为什么要绕一大弯用 VBA？  

PQ 直接透视列，一步就OK了。还能随源数据变化而自动更新。

明天会更好zj

cnmlgb9998 发表于 2024-5-7 21:47
这种问题，为什么要绕一大弯用 VBA？  

PQ 直接透视列，一步就OK了。还能随源数据变化而自动更新。

杀猪焉用牛刀

yanglinzi

1. Sub 汇总()
   
2. Dim arr, brr, i, j, r, d, n
   
3. Set d = CreateObject("scripting.dictionary")
   
4. With Sheet1
   
5.     r = .Cells(Rows.Count, 1).End(xlUp).Row
   
6.     arr = .Range("a2:c" & r)
   
7. End With
   
8. ReDim brr(1 To UBound(arr), 1 To 100)
   
9. n = 1
   
10. c = 1
    
11. For i = 2 To UBound(arr)
    
12.     sa = arr(i, 1)
    
13.     sb = arr(i, 2)
    
14.     If Not d.exists(sa) Then
    
15.          n = n + 1
    
16.          d(sa) = n
    
17.          brr(1, 1) = "菜单名称"
    
18.          brr(n, 1) = arr(i, 1)
    
19.     End If
    
20.     If Not d.exists(sb) Then
    
21.          c = c + 1
    
22.          d(sb) = c
    
23.          brr(1, c) = arr(i, 2)
    
24.     End If
    
25.     x = d(sa)
    
26.     y = d(sb)
    
27.     brr(x, y) = brr(x, y) + arr(i, 3)
    
28. Next
    
29. Sheet1.[m2].Resize(n, c) = brr
    
30. End Sub
    

复制代码

yanglinzi

典型的数据透视表式的汇总

lizhipei78

经典一维转二维，用三个字典最简单最好理解

Yedajun

Qs18 发表于 2024-5-7 20:55
'试试
Sub test()
    Dim arr, dic, t, i, m, n

好像不行呢

Yedajun

明天会更好zj 发表于 2024-5-7 21:43

能发详细操作吗

Yedajun

cnmlgb9998 发表于 2024-5-7 21:47
这种问题，为什么要绕一大弯用 VBA？  

PQ 直接透视列，一步就OK了。还能随源数据变化而自动更新。

能发详细操作吗

Yedajun

lizhipei78 发表于 2024-5-7 22:21
经典一维转二维，用三个字典最简单最好理解

确实你这个比较容易理解

Yedajun

lizhipei78 发表于 2024-5-7 22:21
经典一维转二维，用三个字典最简单最好理解

UBound ( Arr ,2)问一下，这个为什么多个“2”，能否改成UBound ( Arr )？