VBA创建多个数据源的数据透视表

2024-05-19 23:06| 来源: 网络整理| 查看: 265

1、需求：

有多个表数据，格式一致，需要创建到1个数据透视表。

2、举例：

比如要分析工资的数据，工资表是按月分了不同Sheet管理的，现在需要把12个月的数据放到一起创建1个数据透视表。

3、代码实现

用过Excel的应该都用过透视表功能，透视表功能非常强大，而且简单易用，我们一般用透视表都是处理单独1个Sheet的数据，如果要完成多个Sheet的透视处理，可能大家想到的最直接的方法是复制到1个表里再处理，但是这样一旦数据源有变化，又要重新复制。

我们要完成这个功能，比较好的方法是用SQL语句将多个表拼接到一起再用数据透视表。用SQL语句对数据源的格式要求比较严格，所以表格要比较规范，建议：

标题在第1行每一列保证数据格式是一致的，不要又有数字又有文本

如果你会SQL语句的话，不需要VBA也可以完成这个任务，例子需要的SQL语句是：

代码语言：javascript复制Select *,'1月' as 月份 from [1月$] Union All Select *,'2月' as 月份 from [2月$] Union All Select *,'3月' as 月份 from [3月$]

'x月' as 月份目的是为了在透视表里看出数据是属于哪一个Sheet的。

不用VBA的操作演示：

使用VBA代码自动创建，这种能更加方便的增加Sheet：

代码语言：javascript复制Sub vba_main() Dim str_sql As String str_sql = GetSql() Worksheets("透视表").Activate Cells.Clear CreatePivotCache str_sql, Range("A4") End Sub Function GetSql() As String Dim arr() As String ReDim arr(Worksheets.Count - 1 - 1) As String Dim i As Long For i = 1 To Worksheets.Count - 1 arr(i - 1) = "Select *,'" & Worksheets(i).Name & "' as 月份 from [" & Worksheets(i).Name & "$]" Next GetSql = VBA.Join(arr, vbNewLine & " Union All " & vbNewLine) End Function 'str_sql sql语句 'rng 透视表的位置 Function CreatePivotCache(str_sql As String, rng As Range) As Long Dim AdoConn As Object, rst As Object Set AdoConn = CreateObject("ADODB.Connection") Set rst = CreateObject("ADODB.Recordset") AdoConn.Open ProviderStr(rng.Parent.Parent.FullName) rst.Open str_sql, AdoConn With rng.Parent.Parent.PivotCaches.Add(xlExternal) Set .Recordset = rst .CreatePivotTable rng End With rst.Close AdoConn.Close Set rst = Nothing Set AdoConn = Nothing End Function Function ProviderStr(fileName As String) As String If Val(Application.Version) > 11 Then ProviderStr = "Provider =Microsoft.ACE.OLEDB.12.0;Data Source=" _ & fileName & ";Extended Properties=""Excel 12.0;HDR=YES"";" Else ProviderStr = "OLEDB;Provider =Microsoft.Jet.OLEDB.4.0;Data Source=" _ & fileName & ";Extended Properties=""Excel 8.0;HDR=YES"";" End If End Function

【本文地址】

公司简介

联系我们