excel 透视表汇总多工作簿数据令人惊叹的功能第二部excel数据透视.docx

excel 透视表汇总多工作簿数据令人惊叹的功能第二部excel数据透视.docx

《excel 透视表汇总多工作簿数据令人惊叹的功能第二部excel数据透视.docx》由会员分享，可在线阅读，更多相关《excel 透视表汇总多工作簿数据令人惊叹的功能第二部excel数据透视.docx（7页珍藏版）》请在冰豆网上搜索。

excel透视表汇总多工作簿数据令人惊叹的功能第二部excel数据透视

Excel透视表汇总多工作簿数据！

（令人惊叹的功能！

）--第二部-Excel数据透视...

DimpcAsPivotCache

DimptAsPivotTable

DimstrAsString

DimiAsInteger

DimjAsInteger

DimkAsInteger

DimsqlAsString

DimoFileNameAsString

Dimarr（）AsVariant

Dimbrr（）AsVariant

DimsqlstrAsString

Dimstr2AsString

DimdicAsObject

DimConnAsNewADODB.Connection

oFileName=Dir（ThisWorkbook.Path&"\*.xls"）

Application.ScreenUpdating=False

Setdic=CreateObject（"scripting.dictionary"）'创建字典

'删除先前的所有数据透视表，目的在编辑代码时易于调试！

ForEachptInSheet1.PivotTables

pt.TableRange2.Clear'在没有页字段时可采用TableRange1.Clear方法来清除透视表_

。

pt.TableRange2表示全选透视表单元格！

Nextpt

'设置透视表的缓存，采用PivotCaches.Add方法，确定数据源的类型为引用外部数据源！

Setpc=ActiveWorkbook.PivotCaches.Add（SourceType:

=xlExternal）Withpc

'使用connection确定外部数据源的连接方式为ODBC，_

文件类型为excel文件，确定数据源的位置和默认文件夹的位置！

.Connection=Array（"ODBC;DSN=excelfiles;DBQ="&ThisWorkbook.FullName&";DefaultDir="&ThisWorkbook.Path）.CommandType=xlCmdSql'返回命令类型！

本例为返回excel的SQL命令。

sql="SELECT@FROM`"&ThisWorkbook.Path&"\"

DoWhileoFileName<>""

IfoFileName<>ThisWorkbook.NameThen

Conn.Open"Provider=Microsoft.Jet.OLEDB.4.0;"_

&"extendedproperties=excel8.0;"_

&"DataSource="&ThisWorkbook.Path&"\"&oFileName

DimCatAsNewADOX.Catalog'引用ADOX操作库,表,字段等对象

SetCat.ActiveConnection=Conn

DimcTabAsADOX.Table'定义表

DimfldAsADOX.Column'定义字段

ForEachcTabInCat.Tables'循环库中每个表

str=""

ForEachfldIncTab.Columns'循环表中每个字段

Iffld<>"F1"Then'如果为空表,则字段名为"F1",实用表不会以"F1"为字段

'去掉部门名称,科目代码两个固定字段外判断字段是否存在,不存在则执行加入字典

IfNotdic.exists（fld.Name）Andfld.Name<>"部门名称"Andfld.Name<>"科目代码"Then

dic（fld.Name）=""

sqlstr=sqlstr&""&fld.Name'用sqlstr记住即将在SQL语句中用到的SELECT中的字段,且不重复用的""连接成字符串

EndIf

str=str&""&fld.Name'记录不同表中的字段,用""连接成字符串,这里包括部门名称,科目代码,和sqlstr不同的

'本来应该在循环库中每个表时加入字典的,但因为在循环库中每个表时不能判断表是否为空,_

所以只能在表中循环每个字段时判断,如果为"F1"则过滤,这样就可把空表忽略过去

IfNotdic.exists（oFileName&cTab.Name&"表"）Then

i=i+1

dic（oFileName&cTab.Name&"表"）=i'加入字典,并计算数量（实际就是每个非空表的并表明是出自于哪个工作簿）

ReDimPreservearr（1Toi）'定义一个数组,与上面符合表的数量相等

arr（i）=sql&Left（oFileName,Len（oFileName）-4）&"`.`"&cTab.Name&"`"'逐一加入arr数组sql语句

IfNotdic.exists（oFileName&"工作簿"）Then'这里加"工作簿"和"表"一样的没有多大意义,仅仅是区分,_

本来应用两个字典以上,现在用一个怕混淆,所以加些词以区分而已

j=j+1

dic（oFileName&"工作簿"）=""

Ifj>1Thenarr（i）="]"&arr（i）'这里用"]"实际就是把每个不同工作簿用"]"隔开,可按F8查看,_

为的是在以后SQL语句中用"/UNIONALL"替换"UNIONALL]"

EndIf

EndIf

EndIf

Next

ReDimPreservebrr（1Toi）'在上面相应的产生arr（i）的同时也产生brr（i）

Ifstr<>""Thenbrr（i）=str'如果没有Ifstr<>""Then,那么brr（i）将不会忽略空表,而arr（i）是_

忽略空表的,最后每个brr（i）不会对应每个arr（i）,所以这里请用F8逐条运行'

'由Ifstr<>""Then保证每个brr（i）也是有效的并可对应arr（i）,_

另外每个brr（i）就是每个表的所有字段,查看上面的str是如何得来的

Next

Conn.Close

EndIf

oFileName=Dir（）

Loop

Fork=1Toi'i等于每个工作簿每个有数值的工作表的总和,全面我们已经做了

str2=""

Forj=0ToUBound（Split（sqlstr,""））'用Split函数把在字符串中用""联合的每个字段再用""分离出来

IfInStr（brr（k）,Split（sqlstr,""）（j））Then'查找每个brr（k）数组（即每个表）中是否含有某些字段

Ifstr2<>""Thenstr2=str2&","'如果找到,并且不为第一个则用","号连接,大家想一下select语_

句中的每个字段是否用","号隔开

str2=str2&Split（sqlstr,""）（j）'大家可以测试用这种方法测试普通字符串连接操作,","号不会在两边

Else

Ifstr2<>""Thenstr2=str2&","

str2=str2&"0as"&Split（sqlstr,""）（j）'如果没找到,按照SQL语句以及数据透视表如果数据为空则默认为计数_

汇总,如果为0则会默认为数量汇总,所以为"0as字段1"的形式

EndIf

'每个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语句就比较完整了

Next

str=Replace（Join（arr,"/UNIONALL"）,"UNIONALL]","/UNIONALL"）'用JOIN函数把arr数组中各元素用"/UNIONALL"连接,_

以前在每个工作簿间都有"]"隔开,就形成_

<<select......from.../UNIONALLselect......from.../UNIONALL]select......from...>>

'从上面的sql语句可以看出一个工作簿的每个工作表只用"/UNIONALL"连接,而不同工作簿的（即上一个工作_

簿的最后一个工作表和下一个工作簿的第一工作表之间是用"/UNIONALL]"连接,是不一样的._

这样的话,再用"/UNIONALL"替换"UNIONALL]",这样一个完整的SQL语句就完成了,形成_

<<select......from.../UNIONALLselect......from...//UNIONALLselect......from...>>

.CommandText=Split（str,"/"）'如果在用Split函数再加上"/"字符分离拨开,那么表与表之间工作簿与工作簿之间完全符合数据透视表的要求了,哈哈!

EndWith

Setpt=pc.CreatePivotTable（tabledestination:

=Sheet1.Cells（4,1）,tablename:

="pt1"）

pt.ManualUpdate=True'停止透视表的计算，为快速向透视表添加字段做准备！

'使用AddFields方法为数据表添加行，列和页字段，本例中“Data”_

为虚拟的数据字段，表示数据字段放置在透视表的列区域！

pt.AddFieldsRowFields:

="部门名称",ColumnFields:

="Data"

k=0

Fori=1Topt.PivotFields.Count

Ifpt.PivotFields（i）<>"部门名称"Andpt.PivotFields（i）<>"科目代码"Then

k=k+1

Withpt.PivotFields（i）

.Orientation=xlDataField

.Position=k

.Name=""&pt.PivotFields（i）

EndWith

EndIf

Nextpt.ManualUpdate=False'透视表添加完字段后，重新计算数据透视表，以显示正确结果。

pt.ManualUpdate=True

Application.ScreenUpdating=True

Setpt=Nothing'释放变量占用的内存！

Setpc=NothingEndSub