vba 汇总然后变成横向排列

ykcbf1100

戎马书生222 发表于 2024-7-19 09:00
还有一个application.DisplayAlerts =False

20楼是正解。

ykcbf1100

练手，表格转换，结果表含标题自动生成。

ykcbf1100

练手，表格转换。

1. Sub ykcbf()   '//2024.7.19    表格转换,并加上合计行
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("数据")
   
6.         r = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 5)
   
8.     End With
   
9.     ReDim brr(1 To r, 1 To 100)
   
10.     m = 2: n = 1
    
11.     brr(1, 1) = arr(1, 1)
    
12.     For i = 2 To UBound(arr)
    
13.         s = arr(i, 1)
    
14.         If Not d.exists(s) Then
    
15.             m = m + 1
    
16.             d(s) = m
    
17.             brr(m, 1) = s
    
18.         End If
    
19.         r = d(arr(i, 1))
    
20.         s = arr(i, 2)
    
21.         If Not d.exists(s) Then
    
22.             n = n + 3
    
23.             d(s) = n
    
24.             brr(1, n - 2) = s
    
25.             For j = 3 To UBound(arr, 2)
    
26.                 brr(2, n - 5 + j) = arr(1, j)
    
27.             Next
    
28.         End If
    
29.         c = d(arr(i, 2))
    
30.         For j = 3 To UBound(arr, 2)
    
31.             brr(r, c - 5 + j) = arr(i, j)
    
32.         Next
    
33.     Next
    
34.     '//*******************************
    
35.     '//增加合计行数据
    
36.     m = m + 1
    
37.     brr(m, 1) = "合计"
    
38.     For j = 2 To n
    
39.         Sum = 0
    
40.         For i = 3 To m - 1
    
41.             Sum = Sum + brr(i, j)   '//求每列合计
    
42.         Next
    
43.         brr(m, j) = Sum
    
44.     Next
    
45.     '//********************************
    
46.     With Sheets("结果")
    
47.         .UsedRange.Clear
    
48.         .Cells.Interior.ColorIndex = 0
    
49.         .[a1].Resize(2, n).Interior.Color = 49407
    
50.         .[a3].Resize(m - 2, 1).Interior.Color = 5296274
    
51.         .[a1].Resize(2).Merge
    
52.         With .[a1].Resize(m, n)
    
53.             .Value = brr
    
54.             .Borders.LineStyle = 1
    
55.             .HorizontalAlignment = xlCenter
    
56.             .VerticalAlignment = xlCenter
    
57.             With .Font
    
58.                 .Name = "微软雅黑"
    
59.                 .Size = 11
    
60.             End With
    
61.             For j = 2 To n Step 3
    
62.                 .Cells(1, j).Resize(, 3).Merge
    
63.             Next
    
64.         End With
    
65.     End With
    
66.     Application.ScreenUpdating = True
    
67.     MsgBox "OK！"
    
68. End Sub
    

复制代码

戎马书生222

ykcbf1100 发表于 2024-7-19 09:55
练手，表格转换。

特别喜欢你的程序风格，正是适合我的思维的风格。

戎马书生222

ykcbf1100 发表于 2024-7-19 09:55
练手，表格转换。

请问，这一行是什么意思。      brr(2, n - 5 + j) = arr(1, j)
n-5+j怎么算出来的？

ykcbf1100

戎马书生222 发表于 2024-7-19 18:40
请问，这一行是什么意思。      brr(2, n - 5 + j) = arr(1, j)
n-5+j怎么算出来的？

你细味。。。

ykcbf1100

戎马书生222 发表于 2024-7-19 18:40
请问，这一行是什么意思。      brr(2, n - 5 + j) = arr(1, j)
n-5+j怎么算出来的？

我解释一下吧：
    1、转换后，姓名占一列，类别占3列，所以，n=1,然后每个类别n=n+3(如：A，n=4，下同）
    2、For j = 3 To UBound(arr, 2)，这里j从3开始，当j=3时，对数组brr而言，列标应该是2（A而言），为了得到2,就有了n-5+j（4-5+3=2），这就是n-5+j的由来。

戎马书生222

ykcbf1100 发表于 2024-7-19 19:09
你细味。。。

列了一下算式，暂时明白了。n=4,j=3,n'=2;n=4,j=4,n'=3
要想写入第2,3,4列，就变成n+j-5

chxw68

天热睡不着，练练手。

ykcbf1100

chxw68 发表于 2024-7-19 21:31
天热睡不着，练练手。

老师好，现在睡觉早了点吧。