ExcelVBA多工作簿多工作表汇总实例集锦.docxVIP

1，多工作表汇总（ Consolidate ） ‘ ‘两种写法都要求地址用 R1C1 形式，各个表格的数据布置有规定。 SubConsolidateWorkbook() DimRangeArray()AsString DimbkAsWorksheet DimshtAsWorksheet DimWbCountAsInteger Setbk=Sheets(汇总 ) WbCount=Sheets.Count ReDimRangeArray(1ToWbCount-1) ForEachshtInSheets Ifsht.Name 汇总 Then i=i+1 RangeArray(i)=sht.Name!_ sht.Range(A1).CurrentRegion.Address(ReferenceStyle:=xlR1C1) EndIf Next bk.Range(A1).ConsolidateRangeArray,xlSum,True,True [a1].Value= 姓名 EndSub Subsumdemo() DimarrAsVariant arr=Array( 一月 !R1C1:R8C5, 二月 !R1C1:R5C4, 三月 !R1C1:R9C6) WithWorksheets( 汇总 ).Range(A1) .Consolidatearr,xlSum,True,True .Value= 姓名 EndWith EndSub 2，多工作簿汇总（ Consolidate ） ‘多工作簿汇总 SubConsolidateWorkbook() DimRangeArray()AsString DimbkAsWorkbook DimshtAsWorksheet DimWbCountAsInteger WbCount=Workbooks.Count ReDimRangeArray(1ToWbCount-1) ForEachbkInWorkbooks 在所有工作簿中循环 IfNotbkIsThisWorkbookThen 非代码所在工作簿 Setsht=bk.Worksheets(1) 引用工作簿的第一个工作表 i=i+1 RangeArray(i)=[bk.Name]sht.Name!_ sht.Range(A1).CurrentRegion.Address(ReferenceStyle:=xlR1C1) EndIf Next Worksheets(1).Range(A1).Consolidate_ RangeArray,xlSum,True,True EndSub 3，多工作簿汇总（ FileSearch ） ‘2007-1-1.html### ‘ 汇总表 .xls Subpldrwb0531() 汇总表 .xls 导入指定文件的数据 DimmyFsAsFileSearch DimmyPathAsString,Filename$ DimiAsLong,nAsLong DimSht1AsWorksheet,shAsWorksheet Dimaa,nm$,nm1$,m,arr,r1,col1% Application.ScreenUpdating=False SetSht1=ActiveSheet SetmyFs=Application.FileSearch myPath=ThisWorkbook.Path WithmyFs .NewSearch .LookIn=myPath .FileType=msoFileTypeNoteItem .Filename=*.xls If.Execute(SortBy:=msoSortByFileName)0Then n=.FoundFiles.Count col1=2 ReDimmyfile(1Ton)AsString Fori=1Ton myfile(i)=.FoundFiles(i) Filename=myfile(i) aa=InStrRev(Filename,\) nm=Right(Filename,Len(Filename)-aa) nm1=Left(nm,Len(nm)-4) Ifnm1 汇总表 Then Workbooks.Openmyfile(i) DimwbAsWorkbook Setwb=ActiveWorkbook m=[a65536].End(xlUp).Row arr=Range(Cells(3,3),Cells(m,3)) Sht1.Activate col1=col1+1 Cells(2,col1)=nm 自动获取文件名 Cells(3,col1).Resize(UBound(arr),1)=arr wb.Closesavechanges:=False Setwb=Not