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下的文件
                
            
        
浙公网安备 33010602011771号