如何用VBA实现一次性多列数据分类汇总，类似单列数据透视表

·遁去的一·

Hontyu 发表于 2023-5-21 22:13
12年注册的，都不懂得送花，难怪只会提问

怎么送花啊，请教

·遁去的一·

zxsea_7426 发表于 2023-5-21 22:10
加了一个代码，列数多了，速度能快点，单元格操作不再一个一个写入，分表头与数据以及合并单元格三次操作.
...

第一个版本1万行4列，用时690秒，期待这个版本

·遁去的一·

准提部林 发表于 2023-5-21 22:13
一個字典用到底//一列一個數組合併完成//

有教程吗？先行谢过

佳能lT搬砖着

1. Sub PivotTable()
   
2. 
   
3. Dim ws As Worksheet
   
4. Dim pt As PivotTable
   
5. Dim pf As PivotField
   
6. Dim pi As PivotItem
   
7. Dim rng As Range
   
8. Dim lastRow As Long
   
9. Dim lastCol As Long
   
10. Dim i As Long
    
11. Dim j As Long
    
12. Dim keyword As String
    
13. 
    
14. '设置关键字
    
15. keyword = "a"
    
16. 
    
17. '获取当前工作表
    
18. Set ws = ActiveSheet
    
19. 
    
20. '获取数据范围
    
21. lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
22. lastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    
23. Set rng = ws.Range("A1", ws.Cells(lastRow, lastCol))
    
24. 
    
25. '创建数据透视表
    
26. Set pt = ws.PivotTableWizard(TableDestination:=ws.Cells(lastRow + 2, 1), _
    
27.     TableName:="PivotTable")
    
28. 
    
29. '设置行字段
    
30. Set pf = pt.PivotFields("所有")
    
31. pf.Orientation = xlRowField
    
32. 
    
33. '设置列字段
    
34. Set pf = pt.PivotFields("关键字")
    
35. pf.Orientation = xlColumnField
    
36. 
    
37. '设置值字段
    
38. Set pf = pt.PivotFields("值")
    
39. pf.Orientation = xlDataField
    
40. pf.Function = xlSum
    
41. pf.NumberFormat = "#,##0"
    
42. 
    
43. '筛选关键字
    
44. For i = 1 To pf.PivotItems.Count
    
45.     Set pi = pf.PivotItems(i)
    
46.     If pi.Name <> keyword Then
    
47.         pi.Visible = False
    
48.     End If
    
49. Next i
    
50. 
    
51. '自动调整列宽
    
52. ws.Columns.AutoFit
    
53. 
    
54. End Sub
    

复制代码

·遁去的一·

zxsea_7426 发表于 2023-5-21 22:10
加了一个代码，列数多了，速度能快点，单元格操作不再一个一个写入，分表头与数据以及合并单元格三次操作.
...

尴尬了，此版本直接卡死没法运行

·遁去的一·

准提部林 发表于 2023-5-21 22:13
一個字典用到底//一列一個數組合併完成//

ReDim C(1 To Cn), Xrr(1 To Cn), Brr(1 To Rn, 1 To Rn)这句出错了，内存溢出，1万左右数据行，5列，2600行数据时可以正常运行，用时1.7秒

zxsea_7426

·遁去的一· 发表于 2023-5-21 22:32
第一个版本1万行4列，用时690秒，期待这个版本

有一个对单元格一个一个处理的花时间最长

·遁去的一·

佳能lT搬砖着 发表于 2023-5-21 22:47

谢谢您的热心回复，但是没法运行

·遁去的一·

剑指E 发表于 2023-5-21 20:00
“一次性完成a+任意其它（所有）列为关键字的分类汇总”
这句话啥意思？

谢谢大佬 ，速度最快，是不是最多99999行啊，但是前2列里有空白单元格的包含在统计项了，后面几列的空白单元格就没有纳入统计了，所以数据 不对，能帮查一下吗

·遁去的一·

剑指E 发表于 2023-5-21 20:00
“一次性完成a+任意其它（所有）列为关键字的分类汇总”
这句话啥意思？

经测试是，所有列的数据中只统计第一个出现空白单元格的数据，后面的空白单元格均不统计，能改一下吗，所有空白单元格都要统计