多工作簿多表查询汇总的通用解决方案

1、多工作簿多表查询汇总的通用解决方案长期以来，论坛内不断出现求多个工作簿、多个工作表进行汇总的求助贴，开始时，抱着能帮多少就多少的心态去尽自己能力去进行帮助，但有时一天内出现几个汇总求助，只是汇总数据的格式不一样，标题字段不一样而已，作为求助者稍微学习一下VBA基础知识，然后照搬照挪代码，就基本可以自己完成的事，却不厌其烦的出现在求助队列里。本着授之以鱼不如授之以渔的思想，做了一个自己的汇总代码模版，希望能给有汇总需求提供到一定帮助，给初学者一个指引编写代码的学习机会。代码不一定是非常优秀，希望各位大神级的朋友不要贱笑，也敬请多多指教，多多指正。前提，所有操作中的表或工作簿中，必须包含所有查询所

2、需的字段标题，但不一定要按同样顺序附件中，每行代码都注释了作用，希望各位初学者学习一些语句的应用。包含了对工作簿汇总的数组方案、SQL方案；对工作表汇总的数组方案、SQL方案。PS:原文及附件的地址数组解决方案中涉及调整规范数据格式的代码Function规范数据格式(vReadDataAsVariant,vTitleAsVariant)AsVariant将数据规范为一定格式，本例中的格式是：姓名、年龄、籍贯、区域DimoDicAsObject'定义字典对象变量DimnRowAsDouble,nColAsInteger,nNewColAsIntegerDimvDataAsVariant&

3、#39;定义数据规范的数组SetoDic=CreateObject("Scripting.Dictionary")'定义oDic为字典变量'注意：标题的数量要与vReadData数组对应FornRow=LBound(vTitle)ToUBound(vTitle)'从数组的最低标号到最高标号循环oDic(vTitle(nRow)=nRow+1'以标题为关键字的字典，赋值对应于标题数组的标号NextvData=vReadData'令vData与vReadData具有同样容量的数组FornCol=1ToUBound(vReadData,2)

4、'歹1J号从1至UvReadData第二维最高标号，即最右的列号nNewCol=oDic(vReadData(1,nCol)'从vReadData标题行的标题获取数据规范的所在列FornRow=2ToUBound(vReadData)'歹1J号从2至UvReadData第一维最高标号，即最下的行号vData(nRow,nNewCol)=vReadData(nRow,nCol)'把vReadData赋值到数据规范的数组NextNext规范数据格式=vData'返回规范数据的数组EndFunction使用数组访问多个工作簿进行汇总的解决方案Sub数组查找工作

5、簿汇总()DimvReadDataAsVariant'定义读取工作簿中表的数据的数组变量DimvDataAsVariant'定义读取工作簿中表的规范格式数据的数组变量DimwWBAsWorkbook'定义工作簿变量DimsPathAsString'定义文件夹变量DimsFileAsString'定义文件名变量DimnRowAsDouble定义行数变量DimnColAsInteger'定义列数变量DimbAddAsBoolean'定义是否需要作为新记录添加的逻辑变量DimvFillAsVariant'DimnFillAsDouble

6、'定义将要作为查询结果的数组变量定义查询结果数组的行数的变量DimsNameAsString,sPlaceAsString,sAreaAsString,vAgeAsVariantDimvTitleAsVariant'定义标题变量Application.ScreenUpdating=False'禁止数据更新，避免因数据更新时引起闪屏，提高运行速度vTitle=Split("姓名|年龄|籍贯|区域","|")将所有标题用|隔开的字符串根据|分离成数组sName=Trim(A2)'获取查询姓名的条件sPlace=Trim(A6)

7、'获取查询籍贯的条件sArea=Trim(A8)'获取查询区域的条件vAge=A4:B4.Value'获取查询年龄的条件ReDimvFill(1To4,1To1)'定义一个4歹U1行的数组,注意：正常填到表格内的数组是按(行，列)来定义的，因为考虑到行数将不断增加，而且数组只能是最后一个维度上进行变化，所以先将行定义在后面SetwWB=ThisWorkbook'设置本工作簿的变量sPath=wWB.Path&""'获取本工作簿所在文件夹sFile=Dir(sPath&"*.xls*")

8、9;查找sPath文件夹内的与xls有关后缀名的文件DoWhilesFile<>""'如果查找不到相关文件将会返回空字符串，找到的话，将返回文件名的全名IfsFile<>ThisWorkbook.NameThen'如果找到的文件名不等于本工作簿的文件名WithWorkbooks.Open(sPath&sFile)'打开工作簿sFilevReadData=.Sheets(1).UsedRange.Value'将第一个表的所有已用单元格的数值赋值给数组.CloseFalse'关闭工作簿sFileEndWit

9、hvData=规范数据格式(vReadData,vTitle)'如果所有工作簿内数据格式一致，可以跳过本步，上一步的赋值给vReadData的时候直接赋值给vData即可FornRow=2ToUBound(vData)'vData中，第1行是标题，故从2行开始读取数据bAdd=True'初始化变量为真IfsName<>""ThenbAdd=bAddAnd(vData(nRow,1)Like"*"&sName&"*")假如存在姓名条件，且姓名类似条件形式，为真，并跟bAdd进行与运算，

10、例如：条件是”张“，那么”张三“就类似”*张*“IfvAge(1,2)<>""ThenbAdd=bAddAndApplication.Evaluate(vData(nRow,2)&IIf(vAge(1,1)="","=",vAge(1,1)&vAge(1,2)'Evaluate是计算一个字符串形式的式子的值'IIf(vAge(1,1)="","=",vAge(1,1),如果年龄的比较符号vAge(1,1)没有被选择，默认使用等于号'整个语句就是

11、当条件中有年龄条件数值，对比数据中年龄vData(nRow,2)是否符合条件IfsPlace<>""ThenbAdd=bAddAnd(vData(nRow,1)=sPlace)假如存在籍贯条件，且籍贯与条件相同，为真，并跟bAdd进行与运算IfsArea<>""ThenbAdd=bAddAnd(vData(nRow,1)=sArea),假如存在区域条件，且区域与条件相同，为真，并跟bAdd进行与运算IfbAddThen'假如条件符合判断逻辑变量bAdd为真时nFill=nFill+1'为查询数据数组的行数增加一行R

12、eDimPreservevFill(1To4,1TonFill)'为增加一行的查询数据数组重定义FornCol=1To4vFill(nCol,nFill)=vData(nRow,nCol)'复制符合条件的一行数据到查询数据数组最后一行上NextEndIfNextEndIfsFile=Dir'查询一个符合条件的文件LoopThisWorkbook.Activate,本工作簿激活为使用状态WithSheets("汇总")'对"汇总“表进行操作.F:I.ClearContents'清空汇总表内的F:I列数据.F1:I1=Split

13、("姓名，年龄，籍贯，区域",",")通过以逗号为拆分词来拆分字符串所得数组赋值给F1:I1单元格作为标题IfnFill>0Then'假如查询数据数组的记录行数大于0,即表示有数据.F2.Resize(nFill,4)=Application.WorksheetFunction.Transpose(vFill),因为前面定义vFill时按(列，行)定义的，需要通过系统的转置函数Transpose转置为(行,列)数组,赋值给由F2开始变形为nFill行，4列的单元格区域EndIfEndWith'结束对"汇总“表进行操作App

14、lication.ScreenUpdating=TrueIEndSub使用SQL语句处理多文件汇总的解决方案SubSQL查找工作簿汇总()DimoRead_Excel_ConnAsObject'定义数据集对象变量DimsExcel_SelectAsString'定义EXCELS取数据SQL语句变量DimsRead_File_ConnAsString'定义读文件的SQL语句连接变量DimsWhereAsString'SQL语句的条件部分变量DimwWBAsWorkbook'定义工作簿变量DimsPathAsString'定义文件夹变量DimsFil

15、eAsString'定义文件名变量DimsNameAsString,sPlaceAsString,sAreaAsString,vAgeAsVariantDimsTitleAsVariant'定义SQL查找的标题变量DimvTitleAsVariant'定义标题变量Application.ScreenUpdating=False'禁止数据更新，避免因数据更新时引起闪屏，提高运行速度sTitle="姓名,年龄,籍贯,区域"sName=Trim(A2)'获取查询姓名的条件sPlace=Trim(A6)'获取查询籍贯的条件sArea=

16、Trim(A8)'获取查询区域的条件vAge=A4:B4.Value'获取查询年龄的条件sWhere="WhereTrue"'初始SQL的条件语句IfsName<>""ThensWhere=sWhere&"And姓名Like'%"&sName&"%'",假如存在姓名条件，定义姓名类似条件给sWhereIfvAge(1,2)<>""ThensWhere=sWhere&"And年龄"&

17、amp;IIf(vAge(1,1)="","=",vAge(1,1)&vAge(1,2),IIf(vAge(1,1)="","=",vAge(1,1),如果年龄的比较符号vAge(1,1)没有被选择，默认使用等于号,假如存在年龄条件，定义年龄对应关系条件给sWhereIfsPlace<>""ThensWhere=sWhere&"And籍贯=""&sPlace&"'",假如存在籍贯条件，定义籍贯相

18、等条件给sWhereIfsArea<>""ThensWhere=sWhere&"And区域='"&sArea&""',假如存在区域条件，且区域相等条件给sWhereSetoRead_Excel_Conn=CreateObject("Adodb.Connection")'建立读EXCELS据SQL数据集IfVal(Application.Version)<12Then'获取Excel的版本号，低于12为Excel2003版及以下，否则为Exce

19、l2007版及以上oRead_Excel_Conn.Open"Provider=Microsoft.Jet.Oledb.4.0;ExtendedProperties=Excel8.0;DataSource="&ThisWorkbook.FullName'建立数据库连接，Excel2003版及以下ElseoRead_Excel_Conn.Open"Provider=Microsoft.ACE.OLEDB.12.0;ExtendedProperties=Excel12.0;DataSource="&ThisWorkbook.FullN

20、ame'建立数据库连接，Excel2007版及以上EndIfSetwWB=ThisWorkbook'设置本工作簿的变量sPath=wWB.Path&""'获取本工作簿所在文件夹sFile=Dir(sPath&"*.xls*")'查找sPath文件夹内的与xls有关后缀名的文件DoWhilesFile<>""'如果查找不到相关文件将会返回空字符串，找到的话，将返回文件名的全名IfsFile<>ThisWorkbook.NameThen'如果找到的文件

21、名不等于本工作簿的文件名IfLCase(Left(sFile,3)="xls"Then'如果文件名右边三个字符(即后缀名)的小写与2003版本文件一样sRead_File_Conn="Excel8.0;Database="&sPath&sFile&".",使用SQL语句打开非由oRead_Excel_Conn所定义的文件以外的文件，使用这种格式打开，注意别漏了后面的点ElsesRead_File_Conn="Excel12.0;Database="&sPath&sFi

22、le&"."EndIfIfsExcel_Select<>""ThensExcel_Select=sExcel_Select&"UnionAll",如果已经存在SQL语句,使用联合语句关联文件的连接EndIfsExcel_Select=sExcel_Select&"(Select"&sTitle&"From"&sRead_File_Conn&"Sheet1$"&sWhere&")&qu

23、ot;'读取文件中Sheetl表EndIfsFile=Dir'查询一个符合条件的文件LoopThisWorkbook.Activate,本工作簿激活为使用状态WithSheets("汇总")'对"汇总“表进行操作.F:I.ClearContents'清空汇总表内的F:I列数据vTitle=Split(sTitle,",")'将所有标题用，隔开的字符串根据，分离成数组.F1:I1=vTitle'通过以逗号为拆分词来拆分字符串所得的数组赋值给F1:I1单元格作为标题.F2.CopyFromRecord

24、setoRead_Excel_Conn.Execute(sExcel_Select)'执行SQ曲句并赋值至UF2为起始的单元格区域EndWith'结束对"汇总“表进行操作oRead_Excel_Conn.Close'关闭文件SQL连接SetoRead_Excel_Conn=Nothing'清除对象的SQL属性Application.ScreenUpdating=TrueIEndSub使用数组处理多表汇总的解决方案Sub数组查找工作表汇总()DimwSHAsWorksheet'定义工作表的变量DimvReadDataAsVariant'定

25、义读取工作表的数据的数组变量DimvDataAsVariant'定义读取工作表的规范格式数据的数组变量DimnRowAsDouble'定义行数变量DimnColAsInteger'定义列数变量DimbAddAsBoolean'定义是否需要作为新记录添加的逻辑变量DimvFillAsVariant'定义将要作为查询结果的数组变量DimnFillAsDouble'定义查询结果数组的行数的变量DimsNameAsString,sPlaceAsString,sAreaAsString,vAgeAsVariantDimvTitleAsVariant'

26、;定义标题变量Application.ScreenUpdating=False'禁止数据更新，避免因数据更新时引起闪屏，提高运行速度vTitle=Split("姓名|年龄|籍贯|区域","|")将所有标题用|隔开的字符串根据|分离成数组sName=Trim(A2)'获取查询姓名的条件sPlace=Trim(A6)'获取查询籍贯的条件sArea=Trim(A8)'获取查询区域的条件vAge=A4:B4.Value'获取查询年龄的条件ReDimvFill(1To4,1To1)'定义一个4歹U1行的数组,注意：正

27、常填到表格内的数组是按(行，列)来定义的，因为考虑到行数将不断增加，而且数组只能是最后一个维度上进行变化，所以先将行定义在后面ForEachwSHInSheets'查找工作簿中的每一个表IfwSH.Name<>"汇总"Then'如果找到的工作表的标签名不等于“汇总”vReadData=wSH.UsedRange.Value'将工作表的所有已用单元格的数值赋值给数组vData=规范数据格式(vReadData,vTitle),如果所有工作表内数据格式一致，可以跳过本步，上一步的赋值给vReadData的时候直接赋值给vData即可FornR

28、ow=2ToUBound(vData)'vData中，第1行是标题，故从2行开始读取数据bAdd=True'初始化变量为真IfsName<>""ThenbAdd=bAddAnd(vData(nRow,1)Like"*"&sName&"*")假如存在姓名条件，且姓名类似条件形式，为真，并跟bAdd进行与运算，例如：条件是”张“，那么”张三“就类似”*张*“IfvAge(1,2)<>""ThenbAdd=bAddAndApplication.Evaluate(vD

29、ata(nRow,2)&IIf(vAge(1,1)="","=",vAge(1,1)&vAge(1,2)'Evaluate是计算一个字符串形式的式子的值'IIf(vAge(1,1)="","=",vAge(1,1),如果年龄的比较符号vAge(1,1)没有被选择，默认使用等于号'整个语句就是当条件中有年龄条件数值，对比数据中年龄vData(nRow,2)是否符合条件IfsPlace<>""ThenbAdd=bAddAnd(vData(nRow,

30、1)=sPlace)假如存在籍贯条件，且籍贯与条件相同，为真，并跟bAdd进行与运算IfsArea<>""ThenbAdd=bAddAnd(vData(nRow,1)=sArea)'假如存在区域条件，且区域与条件相同，为真，并跟bAdd进行与运算IfbAddThen'假如条件符合判断逻辑变量bAdd为真时nFill=nFill+1'为查询数据数组的行数增加一行ReDimPreservevFill(1To4,1TonFill)'为增加一行的查询数据数组重定义FornCol=1To4vFill(nCol,nFill)=vData(nR

31、ow,nCol)'复制符合条件的一行数据到查询数据数组最后一行上Next|EndIfNextEndIfNextWithSheets("汇总")'对"汇总“表进行操作.F:I.ClearContents'清空汇总表内的F:I列数据.F1:I1=Split("姓名，年龄，籍贯，区域",",")通过以逗号为拆分词来拆分字符串所得数组赋值给F1:I1单元格作为标题IfnFill>0Then'假如查询数据数组的记录行数大于0,即表示有数据.F2.Resize(nFill,4)=Applicatio

32、n.WorksheetFunction.Transpose(vFill)'因为前面定义vFill时按(列，行)定义的，需要通过系统的转置函数Transpose转置为(行，列)数组'赋值给由F2开始变形为nFill行，4列的单元格区域EndIfEndWith'结束对"汇总“表进行操作Application.ScreenUpdating=TrueIEndSub使用SQL处理多表汇总的解决方案SubSQL查找工作表汇总()DimwSHAsWorksheet定义工作表的变量DimoRead_Excel_ConnAsObject'定义数据集对象变量DimsExc

33、el_SelectAsString'定义EXCE读取数据SQL语句变量DimsRead_File_ConnAsString'定义读文件的SQL语句连接变量DimsWhereAsString'SQL语句的条件部分变量DimsNameAsString,sPlaceAsString,sAreaAsString,vAgeAsVariantDimsTitleAsVariant'定义SQL查找的标题变量DimvTitleAsVariant'定义标题变量Application.ScreenUpdating=False'禁止数据更新，避免因数据更新时引起闪屏，提

34、高运行速度sTitle="姓名,年龄,籍贯,区域"sName=Trim(A2)'获取查询姓名的条件sPlace=Trim(A6)'获取查询籍贯的条件sArea=Trim(A8)'获取查询区域的条件vAge=A4:B4.Value'获取查询年龄的条件sWhere="WhereTrue"'初始SQL的条件语句IfsName<>""ThensWhere=sWhere&"And姓名Like'%"&sName&"%'&quo

35、t;假如存在姓名条件，定义姓名类似条件给sWhereIfvAge(1,2)<>""ThensWhere=sWhere&"And年龄"&IIf(vAge(1,1)="","=",vAge(1,1)&vAge(1,2)'IIf(vAge(1,1)="","=",vAge(1,1),如果年龄的比较符号vAge(1,1)没有被选择，默认使用等于号'假如存在年龄条件，定义年龄对应关系条件给sWhereIfsPlace<>&

36、quot;"ThensWhere=sWhere&"And籍贯='"&sPlace&"'"假如存在籍贯条件，定义籍贯相等条件给sWhereIfsArea<>""ThensWhere=sWhere&"And区域='"&sArea&""''假如存在区域条件，且区域相等条件给sWhereSetoRead_Excel_Conn=CreateObject("Adodb.Connection")'建立读EXCELS据SQL数据集IfVal(Application.Version)<12Then'获取Excel的版本号，低于12为Excel2003版及以下，否则为Excel2007版及以上oRead_Excel_Conn.Open"Pro