如何用字典法根据多列内容汇总？谢谢

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.10
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Sheets("数据源")
   
7.         r = .Cells(Rows.Count, 2).End(3).Row
   
8.         arr = .Range("a1").Resize(r, 4)
   
9.         bt = .[c1:d1].Value
   
10.     End With
    
11.     ReDim brr(1 To UBound(arr), 1 To 100)
    
12.     brr(1, 1) = arr(1, 2)
    
13.     m = 2: n = 1
    
14.     On Error Resume Next
    
15.     For i = 2 To UBound(arr)
    
16.         s = arr(i, 1)
    
17.         If Not d.exists(s) Then
    
18.             n = n + 2
    
19.             d(s) = n
    
20.             brr(1, n - 1) = s
    
21.             brr(2, n - 1) = bt(1, 1)
    
22.             brr(2, n) = bt(1, 2)
    
23.         End If
    
24.         s = arr(i, 2)
    
25.         If Not d.exists(s) Then
    
26.             m = m + 1
    
27.             d(s) = m
    
28.             brr(m, 1) = s
    
29.         End If
    
30.         r = d(arr(i, 2)): c = d(arr(i, 1))
    
31.         brr(r, c - 1) = brr(r, c - 1) + arr(i, 3)
    
32.         brr(r, c) = brr(r, c) + arr(i, 4)
    
33.     Next
    
34.     With Worksheets("汇总")
    
35.         .UsedRange.Clear
    
36.         .UsedRange.UnMerge
    
37.         With .[a1].Resize(m, n)
    
38.             .Value = brr
    
39.             .Borders.LineStyle = 1
    
40.             .HorizontalAlignment = xlCenter
    
41.             .VerticalAlignment = xlCenter
    
42.             With .Font
    
43.                 .Name = "微软雅黑"
    
44.                 .Size = 11
    
45.             End With
    
46.             .Cells(1, 1).Resize(2).Merge
    
47.             For j = 2 To n Step 2
    
48.                 .Cells(1, j).Resize(1, 2).Merge
    
49.             Next
    
50.         End With
    
51.     End With
    
52.     Set d = Nothing
    
53.     MsgBox "OK！"
    
54. End Sub
    

复制代码

wsx22

老师，能否在店名后自动加上数量、收入合计二列，谢谢！

chxw68

wsx22 发表于 2024-4-10 20:18
请教chxw68、baofa2老师，在横向自动加上收入、数量合计，同时数量、金额自动变为Arial Narrow格式，如何增 ...

修改好了。

wsx22

谢谢chxw68老师！

今铭昔

笨鸟飞不高

测试.zip (19.29 KB, 下载次数: 13)

2024-4-11 14:48 上传

点击文件名下载附件

练习！

cai2532

这个汇总统计厉害！

leeson7502

参与一下：