合并当前文件夹下的所有Excel文件(VBA版)

问题很多,解决的方法很多,对于合并当前文件夹下的所有Excel文件,我之前分享是使用Python的第三方库Pandas来解决的。

“人生苦短,我用Python”说的就是Python简洁高效的特点。当然即便是每天跟数据打交道的人,也不一定人人都会Python,这里我再分享一种通用一点的方法,使用Excel自带的VBA。

还拿上次需要合并的各班级成绩Excel表为例,在需要合并Excel工作表的文件夹中新建一个Excel文件,命名为“合并.xlsx”,打开该文件,在Visual Basic编辑器中插入模块,将下面的VBA代码粘贴进去。

Sub 合并()
    Dim MyPath, MyName, AWbName
    Dim Wb As Workbook, WbN As String
    Dim i As Long
    Dim Num As Long
    Dim BOX As String

    Application.ScreenUpdating = False '关闭屏幕更新
    MyPath = ActiveWorkbook.Path '获取当前工作簿的文件位置

    '获取文件夹下的所有以“.xls”结尾的文件,根据实际情况可改成“.xlsx”
    MyName = Dir(MyPath & "\" & "*.xls")
    AWbName = ActiveWorkbook.Name '获取当前工作簿的名称
    Num = 0

    Do While MyName <> ""
        If MyName <> AWbName Then
            Set Wb = Workbooks.Open(MyPath & "\" & MyName)
            Num = Num + 1
            With Workbooks(1).ActiveSheet
                '写入Excel文件名,如果文件为“.xlsx”格式,这里的“减 4”改为“减 5”
                .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
                
                '写入Excel文件内容
                For i = 1 To Wb.Sheets.Count
                    Wb.Sheets(i).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
                Next
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
            End With
        End If
        MyName = Dir
    Loop

    Range("A1").Select
    Application.ScreenUpdating = True '恢复屏幕更新
    MsgBox "共合并了" & Num & "个工作簿。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub

运行宏,即可得到合并后的结果:

共有 0 条评论

发表评论

电子邮件地址不会被公开。 必填项已用*标注