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

SubCombineWorkbooks()DimstrFileNameAsStringDimwbAsWorkbookDimwsAsObject'包含工作簿的文件夹,可根据实际修改ConststrFileDirAsString=D:\示例\数据记录\Application.ScreenUpdating=FalseSetwb=Workbooks.Add(xlWorksheet)strFileName=Dir(strFileDir&*.xls*)DoWhilestrFileNamevbNullStringDimwbOrigAsWorkbookSetwbOrig=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.Count1Thenwb.Sheets(wb.Sheets.Count).Name=strFileName&ws.IndexElsewb.Sheets(wb.Sheets.Count).Name=strFileNameEndIfNextwbOrig.CloseSaveChanges:=FalsestrFileName=DirLoopApplication.DisplayAlerts=Falsewb.Sheets(1).DeleteApplication.DisplayAlerts=TrueApplication.ScreenUpdating=TrueSetwb=NothingEndSubSubConsolidateWorkbook()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,TrueEndSubSubUnionWorksheets()Application.ScreenUpdating=FalseDimljAsStringDimdirnameAsStringDimnmAsStringlj=ActiveWorkbook.Pathnm=ActiveWorkbook.Namedirname=Dir(lj&\*.xls*)Cells.ClearDoWhiledirnameIfdirnamenmThenWorkbooks.OpenFilename:=lj&\&dirnameWorkbooks(nm).Activate'复制新打开工作簿的第一个工作表的已用区域到当前工作表Workbooks(dirname).Sheets(1).UsedRange.Copy_Range(A65536).End(xlUp).Offset(1,0)Workbooks(dirname).CloseFalseEndIfdirname=DirLoopEndSub