Excel多表合并

一个目录下的多个工作簿中的第1个工作表,合并到一个新的汇总工作簿中。

Sub 多表合并()

    Dim bt As Range, r As Long, c As Long
    r = 2    '1 是表头所在的行
    c = 7    '7 是表头的列数,其实此变量下面没有使用
    Dim wt As Worksheet
    Set wt = ThisWorkbook.Worksheets(1)    '将汇总表赋给变量wt,下面代码再出现的wt即代表汇总表
    wt.Rows(r + 1 & ":1048576").ClearContents  ' 清除汇总表wt中原表数据,只保留表头
    Application.ScreenUpdating = False
    
    Dim FileName As String, sht As Worksheet, wb As Workbook
    Dim Erow As Long, fn As String, arr As Variant
    
    'Excel VBA中工作簿的相对路径可以用ThisWorkbook.Path语句获得。ThisWorkbook是对包含该代码的工作簿的引用。
     '无论该工作簿位于哪里,ThisWorkbook的Path属性都将提供能定位到该工作簿的路径。
    'FileName = Dir(ThisWorkbook.Path & "\*.xls")     '这里只读取xls文件,如果有xlsx文件,需要改写代码
    FileName = Dir(ThisWorkbook.Path & "\*.xls*")     '这里只读取xls文件,如果有xlsx文件,需要改写代码
    Do While FileName <> ""
        If FileName <> ThisWorkbook.Name Then        ' 判断文件是否是汇总数据的工作簿
            Erow = wt.Range("A1").CurrentRegion.Rows.Count + 1     ' 取得汇总表wt中第一条空行行号
            
            fn = ThisWorkbook.Path & "\" & FileName     '将第1个要汇总处理的工作簿名称赋给变量fn
            Set wb = GetObject(fn)        ' 将变量fn 代表的工作簿对象赋给变量wb
            Set sht = wb.Worksheets(1)    ' 将要汇总的工作表赋给变量sht

            ' sht.Cells(65536,"D").End(xlUp):作用是从D列的最后一行,向上找到第1个非空的单元格
            ' 将工作表中要汇总的记录保存在数组arr里。这里的offset(0,6)表示从D列向右扩展6列,因为这里汇总的表共10列
            
            '判断是xls还是xlsx
            If Right(FileName, 3) = "xls" Then
                arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(65536, "D").End(xlUp).Offset(0, 6))
            End If
            If Right(FileName, 4) = "xlsx" Then       '说明是xlsx格式
                arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(1048576, "D").End(xlUp).Offset(0, 6))
            End If

            ' 将数组arr 中的数据写入工作表。UBound(arr,1)返回arr数组第1维的最大可用下标,这里为最后一行。UBound(arr,2)为最后1列
            wt.Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
            wb.Close False
        End If
        FileName = Dir    ' 用Dir 函数取得其他文件名,并赋给变量
    Loop
    Application.ScreenUpdating = True

End Sub

 

 ThisWorkbook.Path 与 ThisWorkbook.Path & “\”的区别 :

由最早的DOS操作系统定义的
F:\VBA     F盘根目录中的VBA文件(无扩展名)
F:\VBA\    F盘的VBA目录

所以,假如你的文档所在文件夹名是“C:\ABC"
Dir(ThisWorkbook.path) 表示查找C:\下的文件名为ABC的文件
Dir(ThisWorkbook.path & "\")表示查找C:\ABC下的文件

posted @ 2020-05-06 10:12  茶沐书香  阅读(380)  评论(0)    收藏  举报
Bottom