请教一个数据透视表的VBA

Yalishanda30

jsjcjsjc 发表于 2023-5-6 08:52
感谢大佬,问一下为什么都用字典? 而不用数据透视?
因为数据有100万,所以字典效率不行哈

试试SQL，模拟80万数据6秒钟左右，应该可以接受

额。。。实测字典更快。。。

WANT-T

excel操作透视表，比较麻烦，主要是代码通用性不强：

功能给你写出来了， 好好研究吧，基础差点的都不一定能改的了；
效果演示：

核心代码：其它代码见附件

1. Sub 一键透视()
   
2.     Dim Ado As Object, conStr As String, SQL As String
   
3.     Set Ado = CreateObject("ADODB.Connection")
   
4.     If Application.Version >= 11 Then
   
5.         conStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
   
6.     Else
   
7.         conStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=YES"";"
   
8.     End If
   
9.     Ado.Open conStr
   
10.     SQL = "SELECT 类别,Total,Taken FROM [Sheet2$E1:G7]"
    
11.     If Ado.State = 1 Then Debug.Print "测试链接成功！" Else Debug.Print "测试链接失败！": Exit Sub
    
12.     'Exit Sub
    
13.     With GetWorksheet(ThisWorkbook, "Sheet2-结果")
    
14.         .Visible = xlSheetVisible
    
15.         .Cells.Clear
    
16.         .Activate
    
17.         Set objPivotCache = .Parent.PivotCaches.Create(SourceType:=xlExternal)
    
18.         '设定数据透视表缓存对象的记录集为指定的Recordset对象
    
19.         Set objPivotCache.Recordset = Ado.Execute(SQL)
    
20.         '创建透视表
    
21.         With objPivotCache.CreatePivotTable(TableDestination:=.Range("A1"), TableName:=.Name)
    
22.             '设置手动更新
    
23.             .ManualUpdate = False
    
24.             '隐藏值行
    
25.             .ShowValuesRow = False
    
26.             '隐藏折叠按钮
    
27.             .ShowDrillIndicators = False
    
28.             '设置行标签
    
29.             .PivotFields("类别").Orientation = xlRowField
    
30.             .PivotFields("类别").Position = 1
    
31.             '添加度量值
    
32.             .AddDataField .PivotFields("Total"), "Total合计", xlSum
    
33.             .AddDataField .PivotFields("Taken"), "Taken合计", xlSum
    
34.         End With
    
35.         .UsedRange.EntireColumn.AutoFit
    
36.     End With
    
37.     Ado.Close
    
38.     Set Ado = Nothing
    
39. End Sub

复制代码

附件在这里：
回复：工作簿1-20230506.zip (24.85 KB, 下载次数: 5)

2023-5-6 09:35 上传

点击文件名下载附件

WANT-T

jsjcjsjc 发表于 2023-5-6 08:52
感谢大佬,问一下为什么都用字典? 而不用数据透视?
因为数据有100万,所以字典效率不行哈

因为大多数 人的vba水平就停留在数组循环加字典上，仅此而已！所有的vba教程也基本只 教到这里！

jsjcjsjc

WANT-T 发表于 2023-5-6 14:30
因为大多数 人的vba水平就停留在数组循环加字典上，仅此而已！所有的vba教程也基本只 教到这里！

大佬你这说的,哈哈