分类横向匹配汇总

ykcbf1100

改一下。。。

1. Sub ykcbf()   '//2024.8.13  排重汇总,标题行按B列内容写入
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     ReDim brr(1 To 10000, 1 To 100)
   
6.     m = 1
   
7.     brr(1, 1) = "客户"
   
8.     On Error Resume Next
   
9.     With Sheets("数据源")
   
10.         r = .Cells(Rows.Count, 1).End(3).Row
    
11.         c = .UsedRange.Columns.Count
    
12.         arr = .[a1].Resize(r, c)
    
13.     End With
    
14.     n = 1
    
15.     For i = 2 To UBound(arr)
    
16.         s = arr(i, 1)
    
17.         If Not d.exists(s) Then
    
18.             m = m + 1
    
19.             d(s) = m
    
20.             brr(m, 1) = s
    
21.         End If
    
22.         r = d(arr(i, 1))
    
23.         s = arr(i, 2)
    
24.         If Not d.exists(s) Then
    
25.             n = n + 1
    
26.             d(s) = n
    
27.             brr(1, n) = s
    
28.         End If
    
29.         c = d(arr(i, 2))
    
30.         brr(r, c) = brr(r, c) + arr(i, 8)
    
31.     Next
    
32.     n = n + 1
    
33.     brr(1, n) = "总计"
    
34.     With Sheets("统计查看")
    
35.         .UsedRange.Offset(1).Clear
    
36.         .[a2].Resize(1, n).Interior.Color = 49407
    
37.         With .[a2].Resize(m, n)
    
38.             .Value = brr
    
39.             .Borders.LineStyle = 1
    
40.             .HorizontalAlignment = xlCenter
    
41.             .VerticalAlignment = xlCenter
    
42.         End With
    
43.         For i = 3 To m + 1
    
44.             .Cells(i, n) = Application.Sum(.Cells(i, 2).Resize(, n - 2))
    
45.         Next
    
46.     End With
    
47.     Application.ScreenUpdating = True
    
48.     MsgBox "OK！"
    
49. End Sub
    
50. 
    

复制代码

jjmysjg

ykcbf1100 发表于 2024-8-13 07:14
改好了，标题行按B列内容写入。

谢谢老师，就是这个效果

ynzsvt

看看是不是要这样的

liulang0808

格式调整了下，供参考

jjmysjg

liulang0808 发表于 2024-8-13 07:52
格式调整了下，供参考

谢谢版主，是这个效果。

jjmysjg

ynzsvt 发表于 2024-8-13 07:44
看看是不是要这样的

汇总的字段标题不固定，是筛选数据源B列的唯一值写入的。
谢谢帮助

blackttea1

学习啦 ，谢谢