[原创] 透视表汇总5个工作簿数据！(令人惊叹的功能！)

OKJSJSF

终于成功创建多簿多表透视。原来老师的代码中命令文本少写了各个工作簿的后缀 .xls，加上去就成功了。
Option Explicit

Sub 多工作表透视汇总()
Dim ws As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim str As String
Dim i As Integer

Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets("sheet1")
str = ThisWorkbook.Path & "\1.xls"
MsgBox str

'删除先前的所有数据透视表，目的在编辑代码时易于调试！
For Each pt In Sheet1.PivotTables
pt.TableRange2.Clear    '在没有页字段时可采用TableRange1.Clear方法来清除透视表。pt.TableRange2表示全选透视表单元格！
Next pt
   

    '设置透视表的缓存，采用PivotCaches.Add方法，确定数据源的类型为引用外部数据源！
    Set pc = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
   
   
    With pc
        '使用connection确定外部数据源的连接方式为ODBC，文件类型为excel文件，确定数据源的位置和默认文件夹的位置！
        .Connection = Array("ODBC;DSN=excel files;DBQ=" & str & ";DefaultDir=" & ThisWorkbook.Path)
        
        '返回命令类型！本例为返回excel的SQL命令。
        .CommandType = xlCmdSql
        
        '返回或设置指定数据源的命令字符串，在本例中，就是返回执行SQL查询语句的结果。下面使用的是SQL语句。
        .CommandText = Array("SELECT * FROM `" & ThisWorkbook.Path & "\1.xls`.`A$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\1.xls`.`B$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\1.xls`.`C$`" _
        , _
        "UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\2.xls`.`A$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\2.xls`.`B$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\2.xls`.`C$`" _
        , _
        "UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\3.xls`.`A$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\3.xls`.`B$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\3.xls`.`C$`" _
        , _
        "UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\4.xls`.`A$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\4.xls`.`B$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\4.xls`.`C$`" _
        , _
        "UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\5.xls`.`A$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\5.xls`.`B$` UNION ALL SELECT * FROM `" & ThisWorkbook.Path & "\5.xls`.`C$`")
    End With
        
    '创建透视表，指定透视表放置的单元格地址（注意可以带引号的文本格式），指定透视表的名称！
    Set pt = pc.CreatePivotTable(tabledestination:=Sheet1.Cells(4, 1), tablename:="pt1")
   
    '停止透视表的计算，为快速向透视表添加字段做准备！
    pt.ManualUpdate = True
   
   
    '使用AddFields方法为数据表添加行，列和页字段，本例中“Data”为虚拟的数据字段，表示数据字段放置在透视表的列区域！
    pt.AddFields RowFields:="部门名称", ColumnFields:="Data"
   
    With pt.PivotFields("期初余额借方")
        .Orientation = xlDataField      '向透视表添加"期初余额借方"字段，放置在数据区域。
        .Position = 1                   '如果数据区域有多个字段，那么这个字段的位置放在第1。
        .Name = " 期初余额借方"         '给字段重新命名。
    End With
   
    With pt.PivotFields("期初余额贷方")
        .Orientation = xlDataField
        .Position = 2
        .Name = " 期初余额贷方"
    End With
   
   With pt.PivotFields("本期发生额借方")
        .Orientation = xlDataField
        .Position = 3
        .Name = " 本期发生额借方"
    End With
   
    With pt.PivotFields("本期发生额贷方")
        .Orientation = xlDataField
        .Position = 4
        .Name = " 本期发生额贷方"
    End With
   
    With pt.PivotFields("期末余额借方")
        .Orientation = xlDataField
        .Position = 5
        .Name = " 期末余额借方"
    End With
   
    With pt.PivotFields("期末余额贷方")
        .Orientation = xlDataField
        .Position = 6
         .Name = " 期末余额贷方"
    End With
   
   
    '透视表添加完字段后，重新计算数据透视表，以显示正确结果。
    pt.ManualUpdate = False
    pt.ManualUpdate = True
    Application.ScreenUpdating = True
   
    '释放变量占用的内存！
    Set pt = Nothing
    Set pc = Nothing
    Set ws = Nothing

End Sub

梅州

感谢分享，后续学习