Excel-VBA-多工作簿多工作表汇总实例集锦.doc

1，多工作表汇总（Consolidate）‘http://www.excelpx.com/dispbbs.asp?boardID=5&ID=110630&page=1‘两种写法都要求地址用R1C1形式，各个表格的数据布置有规定。SubConsolidateWorkbook()DimRangeArray()AsStringDimbkAsWorksheetDimshtAsWorksheetDimWbCountAsIntegerSetbk=Sheets("汇总")WbCount=Sheets.CountReDimRangeArray(1ToWbCount-1)ForEachshtInSheetsIfsht.Name<>"汇总"Theni=i+1RangeArray(i)="'"&sht.Name&"'!"&_sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)EndIfNextbk.Range("A1").ConsolidateRangeArray,xlSum,True,True[a1].Value="姓名"EndSubSubsumdemo()DimarrAsVariantarr=Array("一月!R1C1:R8C5","二月!R1C1:R5C4","三月!R1C1:R9C6")WithWorksheets("汇总").Range("A1").Consolidatearr,xlSum,True,True.Value="姓名"EndWithEndSub2，多工作簿汇总（Consolidate）‘多工作簿汇总SubConsolidateWorkbook()DimRangeArray()AsStringDimbkAsWorkbookDimshtAsWorksheetDimWbCountAsIntegerWbCount=Workbooks.CountReDimRangeArray(1ToWbCount-1)ForEachbkInWorkbooks'在所有工作簿中循环IfNotbkIsThisWorkbookThen'非代码所在工作簿Setsht=bk.Worksheets(1)'引用工作簿的第一个工作表i=i+1RangeArray(i)="'["&bk.Name&"]"&sht.Name&"'!"&_sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)EndIfNextWorksheets(1).Range("A1").Consolidate_RangeArray,xlSum,True,TrueEndSub3，多工作簿汇总（FileSearch）‘http://club.excelhome.net/thread-442007-1-1.html###‘help\汇总表.xlsSubpldrwb0531()'汇总表.xls'导入指定文件的数据DimmyFsAsFileSearchDimmyPathAsString,Filename$DimiAsLong,nAsLongDimSht1AsWorksheet,shAsWorksheetDimaa,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(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))Sht1.Activatecol1=col1+1Cells(2,col1)=nm'自动获取文件名Cells(3,col1).Resize(UBound(arr),