零点棋牌下载:Excel 多表合并之 VBA 解决方案

来源：百度文库 编辑：偶看新闻 时间：2024/10/03 14:59:09

Excel 多表合并之 VBA 解决方案

by Doodle 7. 十二月 2010 23:06

情况一：单文件多工作表合并，即在一张工作薄中，有多个工作表格，每个表格的内容都一致，只是所属的类别不同。现在要将所有类别表格里的内容全部合并到一张工作表格里。如以下表格（诺基亚零配件清单），一共有200多种型号，每种型号一个清单，现在要将它们全部合并到一张工作表格里。

 

解决方案：插入一张工作表格，命名为“汇总”。按Alt+F11，进入VBA编辑器，写上如下代码：

 01Option Explicit 02  03' 后面要用的，开始粘贴的行号 04Private beginRowNo As Long05  06' 此过程启动汇总 07Private Sub CommandButton1_Click() 08    Dim sheetCount As Integer09    sheetCount = ThisWorkbook.Worksheets.Count 10      11    Dim i As Integer12    beginRowNo = 1 13    ' 以下循环遍历每个表格，将需要汇总的表格里的内容一一粘贴到“汇总”表格里 14    For i = 1 To sheetCount 15        Dim sheetName As String16        sheetName = ThisWorkbook.Worksheets(i).Name 17          18        Select Case LCase(sheetName) 19            Case "summary": 20                MsgBox "跳过 " + sheetName 21            Case "update record": 22                MsgBox "跳过 " + sheetName 23            Case "汇总": 24                MsgBox "跳过 " + sheetName 25            Case Else: 26                DoSubtotal (sheetName) 27        End Select28    Next i 29End Sub30  31' 此过程用来将指定表格名称的表格内容，复制粘贴到“汇总”表格里。 32Private Sub DoSubtotal(ByVal sheetName As String) 33    Dim sourceSheet As Worksheet 34    Dim destSheet As Worksheet 35      36    Set sourceSheet = ThisWorkbook.Worksheets(sheetName) 37    Set destSheet = ThisWorkbook.Worksheets("汇总") 38      39    sourceSheet.UsedRange.Copy 'destSheet.Range("A" & beginrowno) 40    destSheet.Range("A" & beginRowNo).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, True41    beginRowNo = beginRowNo + sourceSheet.UsedRange.Rows.Count 42      43    Set sourceSheet = Nothing44    Set destSheet = Nothing45End Sub

然后，将光标放置在 CommandButton1_Click 过程中的任意位置，按F5运行即可。

情况二：多文件合并，即在一个文件夹里，有多个工作薄文件，它们的第一个表格里的内容形式都一样，现在要将它们全部合并到一个工作薄里。如一个文件夹内，有每天的订单Excel文件，现在要将全部订单数据合并到一个Excel文件内。

解决方案：新建一个Excel工作薄，按Alt+F11，进入VBA编辑器，输入如下代码：

 01Sub 合并工作簿() 02    Dim FilesToOpen 03    Dim x As Integer04  05    On Error GoTo ErrHandler 06    Application.ScreenUpdating = False07  08    FilesToOpen = Application.GetOpenFilename _ 09      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ 10      MultiSelect:=True, Title:="Files to Merge") 11  12    If TypeName(FilesToOpen) = "Boolean" Then13        MsgBox "No Files were selected"14        GoTo ExitHandler 15    End If16  17    x = 1 18    Dim currentWorkSheet As Worksheet 19    Dim rng As Range 20    Set currentWorkSheet = ActiveWorkbook.ActiveSheet 21    Set rng = currentWorkSheet.Range("A1") 22    Dim wkb As Workbook 23    Dim wks As Worksheet 24    ' 以下循环分别将每个工作薄中的第一个工作表里的内容，复制粘贴到当前工作薄的第一张工作表里。 25    While x <= UBound(FilesToOpen) 26        Set wkb = Workbooks.Open(Filename:=FilesToOpen(x)) 27        Set wks = wkb.Worksheets(1) 28          29        rng.Offset(0, 10).Value = wkb.Name 30          31        wks.UsedRange.Copy rng 32          33        Set rng = rng.Offset(wks.UsedRange.Rows.Count, 0) 34        wkb.Close False35          36        x = x + 1 37    Wend 38    Set wks = Nothing39    Set rng = Nothing40    Set wkb = Nothing41    Set currentWorkSheet = Nothing42  43ExitHandler: 44    Application.ScreenUpdating = True45    Exit Sub46  47ErrHandler: 48    MsgBox Err.Description 49    Resume ExitHandler 50End Sub

将光标放在过程“合并工作薄”的任意位置，按F5运行，在弹出的打开文件框中，选择需要合并的全部文件，确定即可。

情况三：多文件合并。类似情况二，但是，只将多个工作薄里的工作表复制到同一个工作薄里，不需要到同一个工作表。

解决方案：类似情况二，代码只有一点点区别：

 01Sub 合并工作簿2() 02    Dim FilesToOpen 03    Dim x As Integer04  05    On Error GoTo ErrHandler 06    Application.ScreenUpdating = False07  08    FilesToOpen = Application.GetOpenFilename _ 09      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ 10      MultiSelect:=True, Title:="Files to Merge") 11  12    If TypeName(FilesToOpen) = "Boolean" Then13        MsgBox "No Files were selected"14        GoTo ExitHandler 15    End If16  17    x = 1 18    ' 主要就是这里，这个循环处理代码与情况二稍有不同！ 19    While x <= UBound(FilesToOpen) 20        Workbooks.Open Filename:=FilesToOpen(x) 21          22        Sheets().Move After:=ThisWorkbook.Sheets _ 23          (ThisWorkbook.Sheets.Count) 24            25        x = x + 1 26    Wend 27  28ExitHandler: 29    Application.ScreenUpdating = True30    Exit Sub31  32ErrHandler: 33    MsgBox Err.Description 34    Resume ExitHandler 35End Sub

注：如果先做情况三，再做情况一，那么就等于情况二。

EXCEL多表合并问题 Excel VBA Excel VBA vba excel excel合并表的问题。 excel VBA小问题 EXCEL VBA 问题 excel VBA教程电子书 Excel VBA 高手进 EXCEL VBA 基础教程下载 Excel VBA中EXCEL对象？ EXCEL表怎样用合并计算的方法 怎么样合并工作表呢?在EXCEL 关于两张EXCEL表的合并， 用VBA编程如何遍历EXCEL每一个工作表 哪有买Excel 2003 VBA教程 谁有excel VBA教程 excel vba ontime的问题 作一个excel-VBA宏 excel中VBA的问题 excel VBA 下拉菜单制作 如何使用VBA启动Excel excel中合并单元格 Excel的合并单元格