一簿中多表创建透视表的练习

OKJSJSF

Sub 以本工作簿为源重复创建连接()
    Dim cnnpath As String
    cnnpath = ThisWorkbook.FullName
    ActiveWorkbook.Connections.AddFromFile cnnpath
    MsgBox "连接总个数 " & ActiveWorkbook.Connections.Count & Chr(10) & "最后一个连接的名称 " & ActiveWorkbook.Connections(ActiveWorkbook.Connections.Count).Name, , "本文件的"
End Sub

OKJSJSF

Sub 删除本工作簿的所有连接()
    Dim n As Byte
    For n = 1 To ActiveWorkbook.Connections.Count
        ActiveWorkbook.Connections(1).Delete
    Next
    MsgBox "已删除本文件的所有连接。"
End Sub

高锰酸钾哦哦

这个跨表查询功能  有时候还是很实用的

OKJSJSF

高锰酸钾哦哦 发表于 2021-5-6 11:39
这个跨表查询功能  有时候还是很实用的

不懂连接，用代码还没整出来。

OKJSJSF

买了《2007版数据透视表应用大全》新书一本，对照书上的方法，在一个工作簿中对其中四个工作表创建汇总透视表，不能成功，提示 “连接失去”？
sub addpivot()

Dim strpath As String, strfullname As String, objcache As PivotCache, objtable As PivotTable
    Application.ScreenUpdating = False
    For Each objtable In ActiveSheet.PivotTables
        objtable.TableRange2.Clear
    Next
    strpath = ThisWorkbook.Path
    strfullname = ThisWorkbook.FullName
'    Set objcache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
    Set objcache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal)
    With objcache
'        .Connection = Array("ODBC;DSN=Excel Files;DBQ=" & strfullname & ";DefaultDir:=" & strpath)
        .Connection = Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strfullname & ";Extended Properties=""Excel 12.0;HDR=YES"";")
        .CommandType = xlCmdSql
        .CommandText = Array("select ""贷"" , * from [贷$] union all select ""款"" , * from [款$] union all select ""明"" , * from [明$] union all select ""细""", " , * from [细$]")
    End With
    Set objtable = objcache.CreatePivotTable(tabledestination:="多表动态汇总!R1C1", tablename:="数据透视表1")
    With objtable
        .HasAutoFormat = False
        .RowAxisLayout xlTabularRow
        .ShowDrillIndicators = False
    End With
    ThisWorkbook.ShowPivotTableFieldList = True
    Application.ScreenUpdating = True
    Set objcache = Nothing
    Set objtable = Nothing

end sub

OKJSJSF

终于找到代码：
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

OKJSJSF

这与录制的宏完全不同，sql命令文本中表名称不能用中括号 [  ]

OKJSJSF

《excel2007数据透视表应用大全》完全正确。

OKJSJSF

数据的现有连接的属性的命令文本的SQL语句练习：
select "蜀国" as 簿名, * from (select "刘备" as 表名, * from [G:\office练习\多簿多表联合透视\蜀国.xlsm].[刘备$] union all select "张飞" as 表名, * from [G:\office练习\多簿多表联合透视\蜀国.xlsm].[张飞$] union all select "关羽" as 表名, * from [G:\office练习\多簿多表联合透视\蜀国.xlsm].[关羽$]) union all
select "吴国" as 簿名, * from (select "周瑜" as 表名, * from [G:\office练习\多簿多表联合透视\吴国.xlsm].[周瑜$] union all select "鲁肃" as 表名, * from [G:\office练习\多簿多表联合透视\吴国.xlsm].[鲁肃$] union all select "吕蒙" as 表名, * from [G:\office练习\多簿多表联合透视\吴国.xlsm].[吕蒙$])

分析，如上图，一个文件夹中有三个工作簿，其中蜀吴联盟是存放联合查询数据表或透视表的工作簿，蜀国、吴国是二个存放数据源的将要被联合的工作簿，其中蜀国工作簿中有刘备、张飞、关羽三个工作表，每个工作表结构相同，即列标题相同、标题行相同，或者可以说是字段相同，吴国工作簿中有周瑜、鲁肃、吕蒙三个工作表，每个工作表结构相同，即列标题相同、标题行相同，或者可以说是字段相同。
第一步，联合蜀国工作簿中的刘备、张飞、关羽三个工作表，生成看不见的查询表，查询表包含数据源的所有字段，重复记录也不去除，同时查询表中增加了一个表名字段，字段值是刘备、张飞、关羽，用于区分每行记录的数据来源，来自于哪个工作表。由于是跨工作簿操作，各表名前要加上工作簿的全名。语句如下：
select "刘备" as 表名, * from [G:\office练习\多簿多表联合透视\蜀国.xlsm].[刘备$] union all select "张飞" as 表名, * from [G:\office练习\多簿多表联合透视\蜀国.xlsm].[张飞$] union all select "关羽" as 表名, * from [G:\office练习\多簿多表联合透视\蜀国.xlsm].[关羽$]
特别注意，语句中逗号“ , ”左边不能有空格，父子从属关系之间的点号“ . ”两边不能有空格，括号" ( ) "内侧不需空格。
第二步，在生成的查询表中增加一个工作簿名字段，用于在多个工作簿联合后，区分每行记录的数据来源，来自于哪个工作簿，生成了一个看不见的嵌套了查询表的新查询表。如果只对一个工作簿中的多个工作表联合，则无需增加这个字段。语句如下：
select "蜀国" as 簿名, * from ( 本括号中是第一步的联合语句 )
第三步与第一步相同，对第二个工作簿的多表进行联合，生成第三个查询表。
第四步与第二步相同，对第三步生成的查询增加工作簿名字段，生成第四个查询表。
第五步，对第二个、第四个查询表进行联合，生成最后的查询表，当然仍然看不见。语句如下：
select "蜀国" as 簿名, * from ( 本括号中是第一步的联合语句 )  union all select "吴国" as 簿名, * from ( 本括号中是第四步的联合语句 )
用上述语句创建的数据表或透视表，既可以对其中任何工作簿中的任一工作表进行筛选或透视，也可以对所有工作簿中的所有工作表同时进行筛选或透视。有前辈用“令人惊叹的功能”描述它一点不过。
如果不怕麻烦，各个工作簿也不是非要放在同一个文件夹中，SQL语句很强大。

OKJSJSF

多亏了大全，没有它，不知何时才能弄明白，用录宏的办法根本改不出创建透视表的代码。