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

Xinger

谢谢分享。。。。

liouyihua

初学透视表，请多多指教

magitang

怎么做出来的啊，很需要

office2008

Option Explicit

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

    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)

    s = "SELECT * FROM `" & ThisWorkbook.Path & "\"

    ReDim arr(1 To 5)
    For i = 1 To 5
        For j = 1 To 3
            arr(i) = arr(i) & s & i & "`.`" & Chr(64 + j) & "$`"
            If j < 3 Then arr(i) = arr(i) & " UNION ALL "
        Next
    Next

    With pc
        '使用connection确定外部数据源的连接方式为ODBC，文件类型为excel文件，确定数据源的位置和默认文件夹的位置！
        .Connection = Array("ODBC;DSN=excel files;DBQ=" & str & ";DefaultDir=" & ThisWorkbook.Path)

        '返回命令类型！本例为返回excel的SQL命令。
        .CommandType = xlCmdSql

        '返回或设置指定数据源的命令字符串，在本例中，就是返回执行SQL查询语句的结果。下面使用的是SQL语句。
        .CommandText = Split(Join(arr, " ,UNION ALL "), ",")
    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


或许还有改进余地 （讨论，对不同列，工作簿数据获取（本工作簿除外），表格数量不同以及获取表格名，要求数据都是从第一行开始，后面一段不知改进余地）

谢谢高手又学一招

[ 本帖最后由 office2008 于 2009-4-17 23:43 编辑 ]

cykzhhj

主要讨论跨工作溥的方法

jifuxue

谢谢分享！

wenvay

在桌面有个长名字的文件夹时出现运行时错误'13',直接放在桌面就可以运行.

cherishhong

谢谢楼主分享

cherishhong

是怎么做到的？能否具体讲一下？

xiaofilove

讲一下怎么做的，如果我要汇总的表格在格式和数量上和你的不一样时，怎么样才能实现这个功能