四时宝库

程序员的知识宝库

使用VBA合并多个Excel文件(vba 多个文件合并)

此前,写了一篇关于如何将一个Excel工作表拆分成多个的文章,受到了各位朋友的广泛关注和讨论。那么今天,我们反其道而行之,将多个统一规范固定格式的Excel 文件合并为一个。这种场景主要是应对某些情况下,可能我们会收集到多个Excel文件,并且这些Excel文件的格式都是统一的。

对于这种问题,最笨的办法无外乎就是逐个地打开源文件,然后复制粘贴,汇集到一个工作表里面。高级一些的办法是使用Microsoft Query或者Power Query做查询合并。但如果某些情况下,无法使用Microsoft Query或者Power Query时候,那么可以考虑VBA来做处理。废话不多说,直接进入主题:

  1. 假设有多个以下格式的工作表,这里我用了三个文件来模拟。

工作表格式如下,假定这些个Excel工作表,都有如下同一个样式,我们需要将其合并到一个工作表里面。

2. VBA代码。

打开VBE,创建一个模块,在此就命名为“importbat”吧。

Sub importbat()
    Dim title_row As Integer
    Dim last_col As String
    Dim not_null_col As Integer
    Dim from_path As String
    Dim to_path As String
    Dim fname As String
    Dim wb As Workbook
    Dim n As Integer
    
    title_row = 3    '定义标题行所在行号,在此仅仅只是模拟方法,较为粗糙,实际应用中,需要灵活处理
    last_col = "D"   '定义区域尾列所在列名
    
    With Application.FileDialog(msoFileDialogFolderPicker)  '获取分割后的文件存储路径
        .Title = "请选择数据源路径"
        If .Show = False Then Exit Sub
        from_path = .SelectedItems(1) & "\" '加入"\",否则,会到选定路径的上一层
    End With

    With Application.FileDialog(msoFileDialogFolderPicker)  '获取分割后的文件存储路径
        .Title = "请选择合并文件存储路径"
        If .Show = False Then Exit Sub
        to_path = .SelectedItems(1) & "\" '加入"\",否则,会到选定路径的上一层
    End With
    
    Application.ScreenUpdating = False
    Application.CutCopyMode = False

    fname = Dir(from_path)
    Set wb = Workbooks.Add
     ' 添加标题行,合并单元格
    With wb.Sheets(1)
     .Range("A1") = "学习用表"
     .Range("A1:D1").Merge
     .[A2:C2] = Array("区域", "金额", "时间")
     .Range("A2:A3").Merge
     .Range("B2:B3").Merge
     .Range("C2:D2").Merge
     .Range("C3") = "余额"
     .Range("D3") = "期限"
     .Range("A1:D3").Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End With
    Do While fname <> ""
        Workbooks.Open filename:=from_path & fname, ReadOnly:=True
        Sheets(1).Range("A" & title_row + 1 & ":" & last_col & Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row).Select
        Selection.Copy
        Workbooks(fname).Close
        wb.Activate
        wb.Sheets(1).Activate
        wb.Sheets(1).Range("A" & Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row + 1).Select '定位到最后一行所在,并选择A列这个单元格
        wb.Sheets(1).PasteSpecial Format:="Unicode 文本", Link:=False, DisplayAsIcon _
            :=False, NoHTMLFormatting:=True
        fname = Dir()
    Loop
    
    wb.Sheets(1).Range("A2" & ":" & last_col & Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row).Select
    With Selection
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .Borders.TintAndShade = 0
        .Borders.Weight = xlThin
    End With
    wb.SaveAs filename:=to_path & "数据合并", FileFormat:=xlExcel8
    MsgBox "文件合并完毕", vbOK, "提示"
End Sub


3. 创建一个表单按钮,绑定宏代码。

将上一步创建的宏模块“importbat”绑定到该窗体按钮上。


4. 运行

退出设计模式,单击按钮,可以看到以上三个文件已经全部导入到一个工作表里面了,就是这么简单


最后,需要说明的是,以上代码只是抛砖引玉,提供了最简单的处理方式,实际应用中,最好不要直接指定行标题以及尾列,这种偷懒的行为,最好是自动去寻找数据区域或者标题区域,这样适用性会更广。


关注我,获取更多的办公技巧

发表评论:

控制面板
您好,欢迎到访网站!
  查看权限
网站分类
最新留言
    友情链接