d.VBA实现Excel多个工作簿合并成一个工作表

越发深挖VBA，越发感觉到自己的编程能力有待提高。主要表现在：1、遇到问题不知怎么下手分析(思路)；2、分析之后不知怎么入手去做(基础)；3、程序调试(能力)。
针对以上问题，我咨询了资深专家。目前解决方法是：多看、多练，针对问题可先去找类似的程序代码，后不断修改完善(并不要求完全从0开始)。

多个工作簿合并成一个工作表

先贴代码：

Sub 合并工作簿至一个工作表()
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m&, IsSheetEmpty As Boolean
'设置文本型MyPath、MyName，最终存放工作簿sh，需要读取的工作簿sht，长整型m，布尔型IsSheetEmpty'
Set sh = ActiveSheet
'sh为当前活动表格'
MyPath = ThisWorkbook.Path & "/"   '此处应输入左斜杠'
'获得当前文件文件夹路径'
MyName = Dir(MyPath & "*.xls")
'指定当前文件夹内所有以 ".xls"结尾的文件'
Application.ScreenUpdating = False
'Application.ScreenUpdating 在Excel的工作表里面数据发生变化后False禁止实时刷新，True[默认值]为表示实时更新数据'
Cells.ClearContents
'清除当前表格的单元格内容'
Do While MyName <> ""        '如果不存在下一个文件，则跳出循环'
    If MyName <> ThisWorkbook.Name Then   '不执行当前文件'
        With GetObject(MyPath & MyName)      '获得文件对象'
        For Each sht In .Sheets          '依次执行文件下的Sheets'
          If IsSheetEmpty = IsEmpty(sht.UsedRange) Then      'UsedRange是工作表属性'
             m = m + 1                         
             If m = 1 Then                    
                sht.[A1].CurrentRegion.Copy sh.[A1]    
             Else
                sht.[A1].CurrentRegion.Offset(0).Copy sh.[A65536].End(xlUp).Offset(1)
             End If
          End If
        Next
        .Close False
        End With
    End If
    MyName = Dir
  Loop
Application.ScreenUpdating = True
MsgBox "所有表格已完成合并"
End Sub

注意需复制在当前文件上,文件保存为.xlsm

代码讲解

整体思路：
1、获得当前文件路径MyPath，获取当前文件夹下所有文件Dir；
2、采用两层循环，逐个读取当前工作簿，再向下读取工作簿中的工作表；
3、实现工作表批量读取并复制到当前文件中。

两层循环、一个语句块：
第一层循环 主要循环查找工作簿，使用Dir实现下一文件读取

Do While MyName<>""    '循环的终止条件为文件名为空，不为空则执行'  
    循环体()                '执行下层循环'  
    MyName=Dir             '实现读取下一工作簿，相当于n++'
Loop

语句块 获得工作表对象

With GetObject(MyPath & MyName)     '返回文件中的 ActiveX 对象的引用,当执行上述代码时，就会启动与指定的 pathname 相关联的应用程序，同时激活指定文件中的对象'
    .Sheets                   '获得当前对象所对应的Sheets'
    .Close False           'Workbooks("01.xls").Close False 退出当前对象不报存'
End With

第二层循环 遍历每个工作表

For  Each sht In .Sheets       '遍历每个Sheets对象'
    循环体(执行关键代码)         '执行循环复制'
    Next           '执行下一个Sheets，相当于n++

关键代码：

sht.[a1].CurrentRegion.Copy sh.[a1]
sht.[a1].CurrentRegion.Offset(0).Copy sh.[a65536].End(xlUp).Offset(1)

CurrentRegion属性
Range的CurrentRegion属性返回的是一个单元格对象；
Offset属性
Range的Offset属性，它代表位于指定单元格区域的一定的偏移量位置上的区域。

VBA对象类型
$ 文本型; % int 整型; & 长整型 long; ! Single 单精度; #double 双精度 ;

最后编辑于：2020.03.01 08:14:37