VBA合并多个Excel工作簿几种数组.doc

《VBA合并多个Excel工作簿几种数组.doc》由会员上传分享，免费在线阅读，更多相关内容在工程资料-天天文库。

1、SubCombineWorkbooks()DimstrFileNameAsStringDimwbAsWorkbookDimwsAsObject '包含工作簿的文件夹,可根据实际修改ConststrFileDirAsString="D:示例数据记录" Application.ScreenUpdating=False Setwb=Workbooks.Add(xlWorksheet)strFileName=Dir(strFileDir&"*.xls*") DoWhilestrFileName<>vbNullStringDimwbO

2、rigAsWorkbookSetwbOrig=Workbooks.Open(Filename:=strFileDir&strFileName,ReadOnly:=True)strFileName=Left(Left(strFileName,Len(strFileName)-4),29) ForEachwsInwbOrig.Sheetsws.CopyAfter:=wb.Sheets(wb.Sheets.Count)IfwbOrig.Sheets.Count>1Thenwb.Sheets(wb.Sheets.Count).Name=s

3、trFileName&ws.IndexElsewb.Sheets(wb.Sheets.Count).Name=strFileNameEndIfNext wbOrig.CloseSaveChanges:=False strFileName=Dir Loop Application.DisplayAlerts=Falsewb.Sheets(1).DeleteApplication.DisplayAlerts=True Application.ScreenUpdating=True Setwb=Nothing EndSubSubCons

4、olidateWorkbook()DimRangeArray()AsStringDimbkAsWorkbookDimshtAsWorksheetDimWbCountAsIntegerWbCount=Workbooks.CountReDimRangeArray(1ToWbCount-1)ForEachbkInWorkbooks'在所有工作簿中循环IfNotbkIsThisWorkbookThen'非代码所在工作簿Setsht=bk.Worksheets(1)'引用工作簿的第一个工作表i=i+1RangeArray(i)="'["&b

5、k.Name&"]"&sht.Name&"'!"&_sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)EndIfNextWorksheets(1).Range("A1").Consolidate_RangeArray,xlSum,True,TrueEndSubSubUnionWorksheets()Application.ScreenUpdating=FalseDimljAsStringDimdirnameAsStringDimnmAsString lj=Ac

6、tiveWorkbook.Pathnm=ActiveWorkbook.Namedirname=Dir(lj&"*.xls*") Cells.Clear DoWhiledirname<>""Ifdirname<>nmThenWorkbooks.OpenFilename:=lj&""&dirname Workbooks(nm).Activate '复制新打开工作簿的第一个工作表的已用区域到当前工作表Workbooks(dirname).Sheets(1).UsedRange.Copy_Range("A65536").End(xlU

7、p).Offset(1,0) Workbooks(dirname).CloseFalseEndIfdirname=DirLoop EndSub