excelvba多工作簿多工作表汇总实例集锦Word下载.docx

1、 Theni = i + 1RangeArray（i） = &！ _（A1）.（ReferenceStyle:=xlR1C1）End IfNext）.Consolidate RangeArray, xlSum, True, True a1.Value = 姓名 End SubSub sumdemo（）Dim arr As Variantarr = Array（” 一月！R1C1:R8C5, 二月！R5C4 三月！R9C6With Worksheets（）.Range（.Consolidate arr, xlSum, True, True .Value = End With2，多工作簿汇总（ C

2、onsolidate ）多工作簿汇总Dim bk As WorkbookFor Each bk In Workbooks 在所有工作簿中循环If Not bk Is ThisWorkbook Then 非代码所在工作簿Set sht = （1） 引用工作簿的第一个工作表! _ （=xlR1C1） End IfWorksheets（1）.Range（）.Consolidate _RangeArray, xlSum, True, True End Sub3，多工作簿汇总（ FileSearch ）2007-1-1 汇总表 .xlsSub pldrwb0531（） 汇总表 .xls 导入指定文件的数

3、据Dim myFs As FileSearchDim myPath As String, Filename$Dim i As Long, n As LongDim Sht1 As Worksheet, sh As WorksheetDim aa, nm$, nm1$, m, arr, r1, col1% = FalseSet Sht1 = ActiveSheetSet myFs = myPath = With myFs.NewSearch.LookIn = myPath.FileType = msoFileTypeNoteItem.Filename = *.xlsIf .Execute（Sor

4、tBy:=msoSortByFileName） 0 Then n = .col1 = 2ReDim myfile（1 To n） As StringFor i = 1 To nmyfile（i） = .FoundFiles（i）Filename = myfile（i）aa = InStrRev（Filename, nm = Right（Filename, Len（Filename） - aa） nm1 = Left（nm, Len（nm） - 4）If nm1 汇总表 myfile（i）Dim wb As Workbook Set wb = ActiveWorkbook m = a65536.

5、End（xlUp）.Row arr = Range（Cells（3, 3）, Cells（m, 3）col1 = col1 + 1a1.SelectSet myFs = Nothing = True End Sub根据上例增加了在一个工作簿中可选择多个工作表进行汇总，运用了文本框多选功能 Public ar, ar1, nm$ 导入指定文件的数据（默认工作表 1 的数据） 直接从 C 列依次导入Dim aa, nm1$, m, arr, r1, col1%= FalseOn Error Resume NextSet myFs = myPath = With myFscol1 = 2 ReDim

6、 myfile（1 To n） As StringDim wb As WorkbookSet wb = ActiveWorkbookFor Each sh In Sheetss = s &s = Left（s, Len（s） - 1） ar = Split（s, For j = 0 To UBound（ar1）If = 9 Then GoTo 100Set sh = （ar1（j）m = sh.a65536.End（xlUp）.Row arr = Range（Cells（3, 3）, Cells（m, 3）Cells（UBound（arr） + 2, col1）Cells（3, col1）.R

7、esize（UBound（arr）, 1） = arrNext jsavechanges:=False Set wb = Nothing s = If VarType（ar1） = 8200 Then Erase ar1 End If该文件夹里没有任何文件 ElseMsgBox Private Sub CommandButton1_Click（）For i = 0 To - 1If （i） = True Then s = s & （i） &Next iIf s 0 Then : GoTo 100 nm = Mid（Sht.a3, 7） d（nm） = 100:Next Sht = True k

8、 =For i = 0 To UBound（k） after:=Sheets增加汇总表，把名字中的” / ”（不能用作表名的）Set Sht1 = ActiveSheet = Replace（k（i）, /, ） 改为” - “ Next i Erase k Set d = Nothing For Each Sht In SheetsWith Sht.ActivateIf InStr（.Name, ） = 0 Then nm = Replace（Mid（.a3, 7）, ） Myr = .h65536.End（xlUp）.Row Arr = .Range（d10:h Myr） Set d =

9、CreateObject（） For i = 1 To UBound（Arr）x = Arr（i, 1）If Not （x） Thenx, Arr（i, 5）d（x） = d（x） + Arr（i, 5）Next k =Set Sht2 = Sheets（nm） myr2 = a65536.End（xlUp）.Row + 1If myr2 9 ThenCells（9, 1）.Resize（1, 2） = Array（PartNo.TTL QtyCells（10, 1）.Resize（UBound（k） + 1, 1） = （k）Cells（10, 2）.Resize（UBound（t） + 1, 1） = （t）Cells（myr2, 1）.Resize（UBound（k） +