1、excel 透视表汇总多工作簿数据令人惊叹的功能第二部 excel数据透视Excel 透视表汇总多工作簿数据！(令人惊叹的功能！)-第二部 - Excel数据透视. 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 sql As String Dim oFileName As String Dim arr() As Variant Dim brr() As Variant Dim sqlstr As String D
2、im str2 As String Dim dic As Object Dim Conn As New ADODB.Connection oFileName = Dir(ThisWorkbook.Path & *.xls) Application.ScreenUpdating = False Set dic = CreateObject(scripting.dictionary) 创建字典 删除先前的所有数据透视表，目的在编辑代码时易于调试！ For Each pt In Sheet1.PivotTables pt.TableRange2.Clear 在没有页字段时可采用TableRa
3、nge1.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= & ThisWork
4、book.FullName & ;DefaultDir= & ThisWorkbook.Path) .CommandType = xlCmdSql 返回命令类型！本例为返回excel的SQL命令。 sql = SELECT FROM & ThisWorkbook.Path & Do While oFileName <> If oFileName <> ThisWorkbook.Name Then Conn.Open Provider=Microsoft.Jet.OLEDB.4.0; _ & extended properties=
5、excel 8.0; _ & Data Source= & ThisWorkbook.Path & & oFileName Dim Cat As New ADOX.Catalog 引用ADOX 操作库,表,字段 等对象 Set Cat.ActiveConnection = Conn Dim cTab As ADOX.Table 定义表 Dim fld As ADOX.Column 定义字段 For Each cTab In Cat.Tables 循环库中每个表 str = For Each fld In cTab.Columns 循环表中每个字段 If fld
6、<> F1 Then 如果为空表,则字段名为F1,实用表不会以F1为字段 去掉部门名称,科目代码两个固定字段外判断字段是否存在,不存在则执行加入字典 If Not dic.exists(fld.Name) And fld.Name <> 部门名称 And fld.Name <> 科目代码 Then dic(fld.Name) = sqlstr = sqlstr & & fld.Name 用 sqlstr 记住即将在 SQL语句中用到的SELECT中的字段,且不重复用的 连接成字符串 End If str = str & & f
7、ld.Name 记录不同表中的字段,用 连接成字符串,这里包括 部门名称,科目代码,和 sqlstr 不同的 本来应该在 循环库中每个表 时加入字典的,但因为在 循环库中每个表时不能判断表是否为空, _ 所以只能在 表中循环每个字段时判断,如果为F1则过滤,这样就可把空表忽略过去 If Not dic.exists(oFileName & cTab.Name & 表) Then i = i + 1 dic(oFileName & cTab.Name & 表) = i 加入字典,并计算数量(实际就是每个非空表的并表明是出自于哪个工作簿) ReDim Preserv
8、e arr(1 To i) 定义一个数组,与上面符合表的数量相等 arr(i) = sql & Left(oFileName, Len(oFileName) - 4) & . & cTab.Name & 逐一加入arr数组sql语句 If Not dic.exists(oFileName & 工作簿) Then 这里加工作簿和表一样的没有多大意义,仅仅是区分, _ 本来应用两个字典以上,现在用一个怕混淆,所以加些词以区分而已 j = j + 1 dic(oFileName & 工作簿) = If j > 1 Then arr(i) = &a
9、mp; arr(i) 这里用 实际就是把每个不同工作簿用 隔开,可按 F8 查看, _ 为的是在以后SQL语句中 用 / UNION ALL 替换 UNION ALL End If End If End If Next ReDim Preserve brr(1 To i) 在上面相应的产生arr(i)的同时也产生brr(i) If str <> Then brr(i) = str 如果没有 If str <> Then , 那么brr(i)将不会忽略空表,而arr(i)是 _ 忽略空表的,最后 每个 brr(i) 不会对应 每个arr(i),所以这里 请用 F8 逐条运
10、行 由 If str <> Then 保证 每个 brr(i) 也是有效的并可对应 arr(i), _ 另外每个 brr(i) 就是 每个表的 所有字段 ,查看上面的 str 是如何得来的 Next Conn.Close End If oFileName = Dir() Loop For k = 1 To i i 等于 每个工作簿每个有数值的工作表的总和,全面我们已经做了 str2 = For j = 0 To UBound(Split(sqlstr, ) 用 Split 函数 把 在字符串中用 联合的每个字段再用 分离出来 If InStr(brr(k), Split(sqlst
11、r, )(j) Then 查找每个brr(k)数组(即每个表)中是否含有某些字段 If str2 <> Then str2 = str2 & , 如果找到,并且不为第一个则 用, 号连接,大家想一下select语 _ 句中的每个字段是否用, 号隔开 str2 = str2 & Split(sqlstr, )(j) 大家可以测试 用这种方法测试普通字符串连接操作,号不会在两边 Else If str2 <> Then str2 = str2 & , str2 = str2 & 0 as & Split(sqlstr, )(j) 如果
12、没找到,按照SQL语句以及数据透视表如果数据为空则默认为计数 _ 汇总,如果为0则会默认为数量汇总,所以为 0 as 字段1 的形式 End If 每个 brr(k) 就是最上面 每个 brr(i) ,就是 k 就是最上面的 i Next arr(k) = Replace(arr(k), , 部门名称,科目代码, & str2) 每个arr(k) 就是最上面的 每个 arr(i),把 每个arr(k)中的 sql字符( SELECT FROM )中 _ 的 替换成 部门名称,科目代码, & str2,str2我们知道是什么了吧,前面已求, _ 这样整个SQL语句就比较完整了 N
13、ext str = Replace(Join(arr, / UNION ALL ), UNION ALL , / UNION ALL ) 用 JOIN 函数 把arr数组中各元素 用 / UNION ALL 连接, _ 以前在每个工作簿间都有 隔开,就形成 _ << select .from . / UNION ALL select .from ./ UNION ALL select .from .>> 从上面的sql语句可以看出一个工作簿的每个工作表只用 / UNION ALL 连接 ,而不同工作簿的(即上一个工作 _ 簿的最后一个工作表 和 下一个工作簿的 第一工作
14、表 之间 是用 / UNION ALL 连接 ,是不一样的 . _ 这样的话 ,再用 / UNION ALL 替换 UNION ALL ,这样一个完整的 SQL语句就完成了,形成 _ << select .from . / UNION ALL select .from ./ UNION ALL select .from .>> .CommandText = Split(str, /) 如果在用Split函数 再加上 /字符分离拨开,那么表与表之间工作簿与工作簿之间完全符合 数据透视表的要求了,哈哈! End With Set pt = pc.CreatePivotTab
15、le(tabledestination:=Sheet1.Cells(4, 1), tablename:=pt1) pt.ManualUpdate = True 停止透视表的计算，为快速向透视表添加字段做准备！ 使用AddFields方法为数据表添加行，列和页字段，本例中“Data” _ 为虚拟的数据字段，表示数据字段放置在透视表的列区域！ pt.AddFields RowFields:=部门名称, ColumnFields:=Data k = 0 For i = 1 To pt.PivotFields.Count If pt.PivotFields(i) <>
16、; 部门名称 And pt.PivotFields(i) <> 科目代码 Then k = k + 1 With pt.PivotFields(i) .Orientation = xlDataField .Position = k .Name = & pt.PivotFields(i) End With End If Next pt.ManualUpdate = False 透视表添加完字段后，重新计算数据透视表，以显示正确结果。 pt.ManualUpdate = True Application.ScreenUpdating = True Set pt = Nothing 释放变量占用的内存！ Set pc = NothingEnd Sub
