ExcelVBA_多工作簿多工作表汇总实例集锦

1、1,多工作表汇总(Consolidate)两种写法都要求地址用R1C1形式，各个表格的数据布置有规定。SubConsolidateWorkbook()DimRangeArray()AsStringDimbkAsWorksheetDimshtAsWorksheetDimWbCountAsIntegerSetbk=Sheets("?匚总、")WbCount=Sheets.CountReDimRangeArray(1ToWbCount-1)ForEachshtInSheetsIfsht.Name<>"汇总"Theni=i+1RangeArray(i

2、)=""'&sht.Name&"'!"&_sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)EndIfNextbk.Range("A1").ConsolidateRangeArray,xlSum,True,Truea1.Value="姓名"EndSubSubsumdemo()DimarrAsVariantarr=Array("一月！R1C1:R8c5","

3、二月！R1C1:R5c4","三月！R1C1:R9c6”)WithWorksheets("汇总").Range("A1").Consolidatearr,xlSum,True,True.Value="姓名"EndWithEndSub2,多工作簿汇总(Consolidate)多工作簿汇总SubConsolidateWorkbook()DimRangeArray()AsStringDimbkAsWorkbookDimshtAsWorksheetDimWbCountAsIntegerWbCount=Workbooks.C

4、ountReDimRangeArray(1ToWbCount-1)ForEachbkInWorkbooks'在所有工作簿中循环IfNotbkIsThisWorkbookThen'非代码所在工作簿Setsht=bk.Worksheets(1)'弓I用工作簿的第一个工作表i=i+1RangeArray(i)="'"&bk.Name&""&sht.Name&"'!"&_sht.Range("A1").CurrentRegion.Address

5、(ReferenceStyle:=xlR1C1)EndIfNextWorksheets(1).Range("A1").Consolidate_RangeArray,xlSum,True,TrueEndSub3,多工作簿汇总(FileSearch)2007-1-1.html#'汇总表.xlsSubpldrwb0531()'汇总表.xls'导入指定文件的数据DimmyFsAsFileSearchDimmyPathAsString,Filename$DimiAsLong,nAsLongDimSht1AsWorksheet,shAsWorksheetDima

6、a,nm$,nm1$,m,arr,r1,col1%Application.ScreenUpdating=FalseSetSht1=ActiveSheetSetmyFs=Application.FileSearchmyPath=ThisWorkbook.PathWithmyFs.NewSearch.LookIn=myPath.FileType=msoFileTypeNoteItem.Filename="*.xls"If.Execute(SortBy:=msoSortByFileName)>0Thenn=.FoundFiles.Countcol1=2ReDimmyfile

7、(1Ton)AsStringFori=1Tonmyfile(i)=.FoundFiles(i)Filename=myfile(i)aa=InStrRev(Filename,"")nm=Right(Filename,Len(Filename)-aa)nm1=Left(nm,Len(nm)-4)Ifnm1<>"汇总表"ThenWorkbooks.Openmyfile(i)DimwbAsWorkbookSetwb=ActiveWorkbookm=a65536.End(xlUp).Rowarr=Range(Cells(3,3),Cells(m,3)S

8、htl.Activatecol1=col1+1Cells(2,col1)=nm'自动获取文件名Cells(3,col1).Resize(UBound(arr),1)=arrwb.Closesavechanges:=FalseSetwb=NothingEndIfNextElseMsgBox”该文件夹里没有任何文件"EndIfEndWitha1.SelectSetmyFs=NothingApplication.ScreenUpdating=TrueEndSub根据上例增加了在一个工作簿中可选择多个工作表进行汇总，运用了文本框多选功能Publicar,ar1,nm$Subpldrw

9、b0531()'汇总表.xls'导入指定文件的数据(默认工作表1的数据)'直接从C列依次导入DimmyFsAsFileSearchDimmyPathAsString,Filename$DimiAsLong,nAsLongDimSht1AsWorksheet,shAsWorksheetDimaa,nm1$,m,arr,r1,col1%Application.ScreenUpdating=FalseOnErrorResumeNextSetSht1=ActiveSheetSetmyFs=Application.FileSearchmyPath=ThisWorkbook.Pat

10、hWithmyFs.NewSearch.LookIn=myPath.FileType=msoFileTypeNoteItem.Filename="*.xls"If.Execute(SortBy:=msoSortByFileName)>0Thenn=.FoundFiles.Countcol1=2ReDimmyfile(1Ton)AsStringFori=1Tonmyfile(i)=.FoundFiles(i)Filename=myfile(i)aa=InStrRev(Filename,"")nm=Right(Filename,Len(Filename

11、)-aa)nm1=Left(nm,Len(nm)-4)Ifnm1<>"汇总表"ThenWorkbooks.Openmyfile(i)DimwbAsWorkbookSetwb=ActiveWorkbookForEachshInSheetss=s&sh.Name&","Nexts=Left(s,Len(s)-1)ar=Split(s,",")UserForm1.ShowForj=0ToUBound(ar1)IfErr.Number=9ThenGoTo100Setsh=wb.Sheets(ar1(j)sh.Act

12、ivatem=sh.a65536.End(xlUp).Rowarr=Range(Cells(3,3),Cells(m,3)Sht1.Activatecol1=col1+1Cells(2,col1)=sh.a1显示引用的工作簿工作表及单元格地址Cells(3,col1).FormulaR1C1="="&nm&""&ar1(j)&”!RC3"Cells(3,col1).AutoFillRange(Cells(3,col1),Cells(UBound(arr)+2,col1)Cells(3,col1).Resize(U

13、Bound(arr),1)=arrNextj100:wb.Closesavechanges:=FalseSetwb=Nothings=""IfVarType(ar1)=8200ThenErasear1EndIfNextElseMsgBox”该文件夹里没有任何文件"EndIfEndWitha1.SelectSetmyFs=NothingApplication.ScreenUpdating=TrueEndSubPrivateSubCommandButton1_Click()Fori=0ToListBox1.ListCount-1IfListBox1.Selected(

14、i)=TrueThens=s&ListBox1.List(i)&",”EndIfNextiIfs<>""Thens=Left(s,Len(s)-1)ar1=Split(s,",")MsgBox"你选择了"&sUnloadUserForm1Else,vbYesNo,"提示")mg=MsgBox（"你没有选择任何工作表！需要重新选择吗?Ifmg=6ThenElseUnloadUserFormlEndIfEndIfEndSubPrivateSubCommandBut

15、ton2_Click()UnloadUserForm1EndSubPrivateSubUserForm_Initialize()WithMe.ListBox1.List=ar文本框赋值.ListStyle=1文本前加选择小方框.MultiSelect=1设置可多选EndWith=&nmEndSub4,多工作表汇总（字典、数组）Data多表汇总0623.xlsSubdbhz()'多表汇总DimSht1AsWorksheet,Sht2AsWorksheet,ShtAsWorksheetDimd,k,t,Myr&,Arr,xApplication.ScreenUpdating

16、=FalseApplication.DisplayAlerts=FalseSetd=CreateObject("Scripting.Dictionary")ForEachShtInSheets删除同名的表格，获得要增加的汇总表格不重复名字IfInStr(Sht.Name,"-")>0ThenSht.Delete:GoTo100nm=Mid(Sht.a3,7)d(nm尸""100:NextShtApplication.DisplayAlerts=Truek=d.keysFori=0ToUBound(k)Sheets.Addafte

17、r:=Sheets(Sheets.Count)SetSht1=ActiveSheetSht1.Name=Replace(k(i),"/","-")增加汇总表，把名字中的“/"(不能用作表名的)改为NextiErasekSetd=NothingForEachShtInSheetsWithSht.ActivateIfInStr(.Name,"-")=0Thennm=Replace(Mid(.a3,7),"/","-")Myr=.h65536.End(xlUp).RowArr=.Range(

18、"d10:h"&Myr)Setd=CreateObject("Scripting.Dictionary")Fori=1ToUBound(Arr)x=Arr(i,1)IfNotd.exists(x)Thend.Addx,Arr(i,5)Elsed(x)=d(x)+Arr(i,5)EndIfNextk=d.keyst=d.itemsSetSht2=Sheets(nm)Sht2.Activatemyr2=a65536.End(xlUp).Row+1Ifmyr2<9ThenCells(9,1).Resize(1,2)=Array("Par

19、tNo.","TTLQty")Cells(10,1).Resize(UBound(k)+1,1)=Application.Transpose(k)Cells(10,2).Resize(UBound(t)+1,1)=Application.Transpose(t)ElseCells(myr2,1).Resize(UBound(k)+1,1)=Application.Transpose(k)Cells(myr2,2).Resize(UBound(t)+1,1)=Application.Transpose(t)EndIfErasekErasetSetd=NothingE

20、ndIfEndWithNextShtApplication.ScreenUpdating=TrueEndSub5,多工作簿提取指定数据(FileSearch)2011-8-319188-1-1.htmlSubGetData()DimBrrbz(1To200,1To19),Brrgr(1To500,1To23)DimmyFsAsFileSearch,myfileDimmyPathAsString,Filename$,wbnm$Dimi&,n&,mm&,aa$,nm1$,j&DimSht1AsWorksheet,shAsWorksheet,wb1AsWorkbook

21、Application.ScreenUpdating=FalseSetwb1=ThisWorkbookwbnm=Left(wb1.Name,Len(wb1.Name)-4)SetSht1=ActiveSheetSht1.a2:w200="”aa=Left(Sht1.Name,2)SetmyFs=Application.FileSearchmyPath=ThisWorkbook.Path&""WithmyFs.NewSearch.LookIn=myPath.FileType=msoFileTypeNoteItem.Filename="*.xls&q

22、uot;.SearchSubFolders=TrueIf.Execute(SortBy:=msoSortByFileName)>0Thenn=.FoundFiles.CountReDimmyfile(1Ton)AsStringFori=1Tonmyfile(i)=.FoundFiles(i)Filename=myfile(i)nm1=Split(Mid(Filename,InStrRev(Filename,"")+1),".")(0)Ifnm1=wbnmThenGoTo200Workbooks.Openmyfile(i)DimwbAsWorkboo

23、kSetwb=ActiveWorkbookForEachshInSheetsIfInStr(sh.Name,aa)Thensh.ActivateIfaa="班子"Thenmm=mm+1Brrbz(mm,1)=b2.ValueForj=2To18Step2Ifj<10ThenBrrbz(mm,j尸Cells(j/2+34,11).ValueElseBrrbz(mm,j尸Cells(j/2+34,9).ValueEndIfNextGoTo100ElseIfb2=""ThenGoTo50mm=mm+1Brrgr(mm,1)=b2.ValueBrrgr(m

24、m,2)=e38.ValueBrrgr(mm,3)=i38.ValueForj=4To18Step2Ifj<12ThenBrrgr(mm,j)=Cells(j/2+38,8).ValueElseBrrgr(mm,j)=Cells(j/2+38,7).ValueEndIfNextForj=20To23Brrgr(mm,j)=Cells(j+28,8).ValueNextEndIfEndIf50:Next100:wb.Closesavechanges:=FalseSetwb=Nothing200:NextElseMsgBox”该文件夹里没有任何文件"EndIfEndWithIfaa

25、="班子"Thena2.Resize(mm,19)=BrrbzElsea2.Resize(mm,23)=BrrgrEndIfa1.SelectSetmyFs=NothingEndSub2011-7-15Subpldrsj()批量导入指定文件的数据?DimmyFsAsFileSearch,myfile,Brr?DimmyPath$,Filename$,nm2$?Dimi&,j&,n&,aa$,nm$?DimSht1AsWorksheet,shAsWorksheet?Application.ScreenUpdating=False?SetSht1=Act

26、iveSheet?nm2=ActiveWorkbook.Name?SetmyFs=Application.FileSearch?myPath=ThisWorkbook.Path?WithmyFs?.NewSearch?.LookIn=myPath?.FileType=msoFileTypeNoteItem?.Filename="*.xls”?.SearchSubFolders=True?If.Execute(SortBy:=msoSortByFileName)>0Then?n=.FoundFiles.Count?ReDimBrr(1Ton,1To2)?ReDimmyfile(1

27、Ton)AsString?Fori=1Ton?myfile(i)=.FoundFiles(i)?Filename=myfile(i)?aa=InStrRev(Filename,"")?nm=Right(Filename,Len(Filename)-aa)?带后缀的Excel文件名?Ifnm<>nm2Then?j=j+1?Workbooks.Openmyfile(i)?DimwbAsWorkbook?Setwb=ActiveWorkbook?Setsh=wb.Sheets("Sheet1")?Brr(j,1)=nm?Brr(j,2)=sh.c3

28、.Value?wb.Closesavechanges:=False?Setwb=Nothing?EndIf?Next?Else?MsgBox"该文件夹里没有任何文件"?EndIf?EndWith?Sht1.Select?a3.Resize(UBound(Brr),2)=Brr?SetmyFs=NothingApplication.ScreenUpdating=TrueEndSubSubpldrsj0707()6387-1-1.html'Report2.xls批量导入指定文件的数据DimmyFsAsFileSearch,myfileDimmyPathAsString,

29、Filename$,ma&,mc&DimiAsLong,nAsLong,nn&,aa$,nm$,nm1$DimSht1AsWorksheet,shAsWorksheetApplication.ScreenUpdating=FalseSetSht1=ActiveSheet:nn=5Sht1.b5:e27="”SetmyFs=Application.FileSearchdata"指定的子文件夹内搜索WithmyFs.NewSearch.LookIn=myPath.FileType=msoFileTypeNoteItem.Filename="*.

30、xls".SearchSubFolders=TrueIf.Execute(SortBy:=msoSortByFileName)>0Thenn=.FoundFiles.CountReDimmyfile(1Ton)AsStringFori=1Tonmyfile(i)=.FoundFiles(i)Filename=myfile(i)nm1=split(mid(filename,instrrev(filename,"")+1),".")(0)一句代码代替以下3句aa=InStrRev(Filename,"")nm=Right(

31、Filename,Len(Filename)-aa)'带后缀的Excel文件名rim1=Left(nm,Len(nm)-4)'去除后缀的Excel文件名Ifnm1<>Sht1.NameThenWorkbooks.Openmyfile(i)DimwbAsWorkbookSetwb=ActiveWorkbookForEachshInSheetssh.Activatema=b65536.End(xlUp).RowIfma>6Then第6行是表头Ifma>10Thenma=10只要取4行数据Forii=7TomaSht1.Cells(nn,2).Resize(1

32、,3)=Cells(ii,2).Resize(1,3).ValueSht1.Cells(nn,5)=Cells(ii,6).Valuenn=nn+1NextiiGoTo100ElseGoTo100EndIfmc=d65536.End(xlUp).RowIfmc>7Then第7行是表头Ifmc>11Thenmc=11只要取4行数据Forii=8TomcSht1.Cells(nn,2).Resize(1,3)=Cells(ii,4).Resize(1,3).ValueSht1.Cells(nn,5)=Cells(ii,8).Valuenn=nn+1NextiiGoTo100ElseGo

33、To100EndIf100:Nextshwb.Closesavechanges:=FalseSetwb=NothingEndIfNextElseMsgBox"该文件夹里没有任何文件"EndIfEndWitha1.SelectSetmyFs=NothingApplication.ScreenUpdating=TrueEndSubsum.xlsSubpldrsj0724()批量导入指定文件的数据DimmyFsAsFileSearch,myfile,Myr1&,ArrDimmyPath$,Filename$,nm2$Dimi&,j&,n&,nn&a

34、mp;,aa$,nm$,nm1$DimSht1AsWorksheet,shAsWorksheetApplication.ScreenUpdating=FalseSetSht1=ActiveSheetMyr1=Sht1.a65536.End(xlUp).RowArr=Sht1.Range("a3:b"&Myr1)Sht1.Range("b3:b"&Myr1).ClearContentsnm2=Left(ActiveWorkbook.Name,Len(ActiveWorkbook.Name)-4)SetmyFs=Application.Fil

35、eSearchmyPath=ThisWorkbook.PathWithmyFs.NewSearch.LookIn=myPath.FileType=msoFileTypeNoteItem.Filename="*.xls"If.Execute(SortBy:=msoSortByFileName)>0Thenn=.FoundFiles.CountReDimmyfile(1Ton)AsStringFori=1Tonmyfile(i)=.FoundFiles(i)Filename=myfile(i)aa=InStrRev(Filename,"")nm=Rig

36、ht(Filename,Len(Filename)-aa)'带后缀的Excel文件名nm1=Left(nm,Len(nm)-4)'去除后缀的Excel文件名Ifnm1<>nm2ThenWorkbooks.Openmyfile(i)DimwbAsWorkbookSetwb=ActiveWorkbookForEachshInSheetsForj=1ToUBound(Arr)Ifsh.Name=Arr(j,1)Thensh.ActivateSetr1=Range("c:c").Find(sh.Name)nn=r1.RowArr(j,2)=Cells(n

37、n,9)GoTo100EndIfNextjNextsh100:wb.Closesavechanges:=FalseSetwb=NothingEndIfNextElseMsgBox”该文件夹里没有任何文件"EndIfEndWithSht1.Selectb3.Resize(UBound(Arr),1)=Application.Index(Arr,0,2)SetmyFs=NothingApplication.ScreenUpdating=TrueEndSub6,多工作表提取指定数据(数组)Subfpkf()Application.ScreenUpdating=FalseDimMyr&

38、;,Arr,yf,x&,Myr1&,r1DimShtAsWorksheetMyr=Sheet1.b65536.End(xlUp).RowSheet1.Range("c8:h"&Myr).ClearContentsArr=Sheet1.Range("c8:h"&Myr)j8.Formula="=rc-9&""|""&rc-8”j8.AutoFillRange("j8:j"&Myr)Range("j8:j"&

39、;Myr)=Range("j8:j"&Myr).ValueForEachShtInSheetsIfSht.Name<>Sheet1.NameThenyf=Left(Sht.Name,Len(Sht.Name)-2)Sht.ActivateMyr1=a65536.End(xlUp).Row-1Forx=7ToMyr1IfCells(x,1)<>""ThenSetr1=Sheet1.Range("j:j").Find(Cells(x,1)&T&Cells(x,2)IfNotr1IsNothi

40、ngThenArr(r1.Row-7,yf)=Cells(x,"ar")EndIfEndIfNextxEndIfNextSheetl.Activatec8.Resize(UBound(Arr),UBound(Arr,2)=Arrj:j.ClearApplication.ScreenUpdating=TrueEndSub7,多工作簿多工作表查询汇总去重复值(字典数组)详细记录.xls3个工作簿需要都打开Subxxjl()DimSht1AsWorksheet,ShtAsWorksheetDimwb1AsWorkbook,wb2AsWorkbook,wb3AsWorkbookDi

41、mi&,Myr2&,Arr2,Myr&,Arr,Myr1&,xm$,yl$Application.ScreenUpdating=FalseSetwb1=ActiveWorkbookSetwb2=Workbooks("购进")Setwb3=Workbooks("配料")wb2.ActivateMyr2=a65536.End(xlUp).RowArr2=Range("a2:d"&Myr2)wb3.ActivateFori=1ToUBound(Arr2)?wb3.Activate?xm=Arr2(i,

42、2)?ForEachShtInSheets?IfSht.Name=xmThen?Sht.Activate?Myr=a65536.End(xlUp).Row?Arr=Range("a1:b"&Myr)?Forj=1ToUBound(Arr)?yl=Arr(j,1)?wb1.Activate?ForEachSht1InSheets?IfSht1.Name=ylThen?Sht1.Activate?Myr1=a65536.End(xlUp).Row+1?Cells(Myr1,1)=Arr2(i,1)?Cells(Myr1,3)=Arr2(i,3)?Cells(Myr1,2

43、)=Arr2(i,4)*Arr(j,2)?ExitFor?EndIf?Next?Nextj?GoTo100?EndIf?Next100:NextiCallqccfApplication.ScreenUpdating=TrueEndSubSubqccf()DimShtAsWorksheet,Myr&,Arr,i&,xDimd,k,t,Arr1,j&Application.ScreenUpdating=FalseForEachShtInSheets?Sht.Activate?Myr=a65536.End(xlUp).Row?Arr=Range("a2:c"

44、;&Myr)?Setd=CreateObject("Scripting.Dictionary")?IfMyr<3ThenGoTo100?Fori=1ToUBound(Arr)?x=Arr(i,1)&","&Arr(i,3)?IfNotd.exists(x)Then?d(x)=Arr(i,2)?Else?d(x)=d(x)+Arr(i,2)?EndIf?Next?k=d.keys?t=d.items?ReDimArr1(1ToUBound(k)+1,1To3)?Forj=0ToUBound(k)?Arr1(j+1,1)=Spl

45、it(k(j),",")(0)?Arr1(j+1,3)=Split(k(j),",")(1)?Arr1(j+1,2)=t(j)?Nextj?Range("a2:c"&Myr).ClearContents?a2.Resize(UBound(Arr1),3)=Arr1100:?Setd=NothingNextApplication.ScreenUpdating=TrueEndSub8,多工作簿对比(FileSearch)599&pid=3285214&page=1&extra=page%3D1Subdgzb

46、db(),多工作簿对比'by:蓝桥2009-11-7DimmyFsAsFileSearchDimmyPathAsString,Filename$Dimi&,n&,nm$,myfileDimSht1AsWorksheet,shAsWorksheetDimwb1AsWorkbook,yf,j&,m1&Dimm,arr,r1Application.ScreenUpdating=FalseApplication.DisplayAlerts=FalseOnErrorResumeNextSetwb1=ThisWorkbookSetmyFs=Application.F

47、ileSearchmyPath=ThisWorkbook.PathForEachSht1InSheets?IfInStr(Sht1.a1,”费用明细表")>0Then?nm=Left(Sht1.a1,Len(Sht1.a1)-5)?Sht1.Activate?WithmyFs?.NewSearch?.LookIn=myPath?.FileType=msoFileTypeNoteItem?.Filename=nm&".xls"?.SearchSubFolders=True?If.Execute(SortBy:=msoSortByFileName)>

48、;0Then?myfile=.FoundFiles(1)?Workbooks.Openmyfile?DimwbAsWorkbook?Setwb=ActiveWorkbook?Setsh=wb.ActiveSheet?m=sh.a65536.End(xlUp).Row?arr=sh.Range(Cells(2,1),Cells(m,6)?yf=Val(Split(arr(2,1),".")(1)?Sht1.Activate?Forj=1ToUBound(arr)?Setr1=Sht1.Range("c:c").Find(arr(j,3)?Ifr1IsNot

49、hingThen?m1=Sht1.d65536.End(xlUp).Row?Cells(m1,1).EntireRow.Insertshift:=xlUp?Cells(m1,1)=Cells(m1-1,1)+1?Cells(m1,2)=arr(j,3)?Cells(m1,yf+3)=arr(j,6)?EndIf?Nextj?wb.Closesavechanges:=False?Setwb=Nothing?EndIf?EndWith?EndIfNextSetmyFs=NothingApplication.DisplayAlerts=TrueApplication.ScreenUpdating=T

50、rueEndSub9,多工作簿汇总（FileSearch+字典）Subpldrwb1123()'合并.xls'导入指定文件的数据DimmyFsAsFileSearchDimmyPathAsString,Filename$Dimi&,n&,y&,bb,j&,xDimSht1AsWorksheet,shAsWorksheetDimaa,nm$,nm1$,m,Arr,r1,mm&Dimd,k,t,d1,t1Application.ScreenUpdating=Falsemm=8SetSht1=ActiveSheetSht1.a8:h1000.C

51、learContentsSetmyFs=Application.FileSearchmyPath=ThisWorkbook.PathWithmyFs.NewSearch.LookIn=myPath.FileType=msoFileTypeNoteItem.Filename="*.xls".SearchSubFolders=TrueIf.Execute(SortBy:=msoSortByFileName)>0Thenn=.FoundFiles.CountReDimmyfile(1Ton)AsStringFori=1Tonmyfile(i)=.FoundFiles(i)F

52、ilename=myfile(i)aa=InStrRev(Filename,"")nm=Right(Filename,Len(Filename)-aa)nm1=Left(nm,Len(nm)-4)Ifnm1<>"合并"ThenWorkbooks.Openmyfile(i)DimwbAsWorkbookSetwb=ActiveWorkbookm=a65536.End(xlUp).RowArr=Range(Cells(8,1),Cells(m,7)Setd=CreateObject("Scripting.Dictionary"

53、)Setd1=CreateObject("Scripting.Dictionary")Forj=1ToUBound(Arr)x=Year(Arr(j,1)&"年"&Month(Arr(j,1)&"月”&T&Arr(j,2)&T&Arr(j,3)&T&Arr(j,5)d(x)=d(x)+Arr(j,4)d1(x)=Arr(j,7)Nextk=d.keyst=d.itemst1=d1.itemsSht1.ActivateFory=0ToUBound(k)bb=Split(k(y

54、),T)Cells(mm,1)=nm1Cells(mm,2)=bb(0)Cells(mm,3)=bb(1)Cells(mm,4)=bb(2)Cells(mm,5)=t(y)Cells(mm,6)=bb(3)Cells(mm,7)=t(y)*bb(3)Cells(mm,8)=t1(y)mm=mm+1Nextwb.Closesavechanges:=FalseSetwb=NothingSetd=NothingSetd1=NothingEndIfNextElseMsgBox"该文件夹里没有任何文件"EndIfEndWitha1.SelectSetmyFs=NothingAppli

55、cation.ScreenUpdating=TrueEndSub10,多工作簿多工作表提取数据(DoWhile)3D1年度汇总.xlsSubndhz()DimArr,myPath$,myName$,wbAsWorkbook,shAsWorksheetDimm&,funm$,shnm$,col%,i&Application.ScreenUpdating=FalseSetwb=ThisWorkbookfunm="年度汇总.xls"myPath=ThisWorkbook.Path&""myName=Dir(myPath&&quo

56、t;*.xls")DoWhilemyName<>""AndmyName<>funmWithGetObject(myPath&myName)Arr=.Sheets("领料").Range("A1").CurrentRegionForEachshInwb.Sheetsshnm=sh.Namesh.ActivateIfInStr(shnm,"班")>0Thencol=11Elsecol=7EndIfFori=2ToUBound(Arr)IfArr(i,col)=shnmTh

57、enm=sh.a65536.End(xlUp).Row+1Cells(m,1).Resize(1,12)=Application.Index(Arr,i,0)EndIfNextNext.CloseFalseEndWithmyName=DirLoopApplication.ScreenUpdating=TrueEndSubSubtqsj()DimArr,myPath$,myName$,wbAsWorkbook,shAsWorksheetDimm&,funm$,shnm$,col%,i&,Myr&,Sht1AsWorksheet,pm$Application.ScreenU

58、pdating=FalseOnErrorResumeNextSetSht1=ActiveSheeta2:g1000.ClearContentsfunm="提取数据.xls":m=1myPath=ThisWorkbook.Path&""myName=Dir(myPath&"*.xls")DoWhilemyName<>""AndmyName<>funmWithGetObject(myPath&myName)Setwb=Workbooks(myName)ForEachshI

59、nwb.Sheetsshnm=sh.Namesh.Activatepm=sh.a4.ValueMyr=sh.a65536.End(xlUp).RowArr=sh.Range("b9:e"&Myr)m=m+1WithShtl.Cells(m,1)=myName.Cells(m,2)=pm.Cells(m,3)=shnm.Cells(m,4).Resize(UBound(Arr),4)=ArrEndWithm=m+UBound(Arr)-1Next.CloseFalseEndWithmyName=DirLoopApplication.ScreenUpdating=TrueEndSub我想要的结果.xlsSubzdgx()DimArr,myPath$,myName$,shAsWorksheetDimm&,funm$,n&,ShtAsWorksheetApplication.ScreenUpdating=Falsefunm="我想要的结