Excel应用实践11:合并多个工作簿中的数据——示例2

2019-07-19 15:19:12 浏览数 (1)

学习Excel技术,关注微信公众号:

excelperfect

需求总是千变万化的,代码也可千变万化,最重要的是能够解决问题!

在上一篇文章《Excel应用实践10:合并多个工作簿中的数据》中,我们使用代码快速合并超过50个Excel工作簿文件,然而,如果要合并的工作簿中工作表的名称不相同,但位于每个工作簿的第1个工作表;并且,要在合并后的工作表的第1列中输入相对应的工作簿文件名,以便知道合并后的数据来自哪个工作簿文件。

同样,可以使用VBA代码快速解决。多的话不说,先上代码:

代码语言:javascript复制
Sub Combine()
    '声明变量
    Dim fn, e
    Dim ws As Worksheet
    Dim flg As Boolean
    Dim LastR As Range
    Dim wsName As String
    '打开选择文件对话框
    fn = Application.GetOpenFilename _
      ("Excel(*.xls*),*.xls*",MultiSelect:=True)
    '如果没有选取文件,则退出
    If Not IsArray(fn) Then Exit Sub
    '在当前工作簿中添加新工作表
    Set ws = ActiveWorkbook.Sheets.Add
    '将新添加的工作表命名为Combined
    ws.Name = "Combined"
    '将新添加的工作表赋值给变量ws
    Set ws =ActiveWorkbook.Sheets("Combined")
    '关闭屏幕刷新
    Application.ScreenUpdating = False
    '清除工作表中的数据
    ws.Cells.Clear
    '遍历选取的工作簿文件
    For Each e In fn
        '打开要从中获取数据的文件
        With Workbooks.Open(e)
            '选取文件中的第1个工作表
            With .Sheets(1)
                '获取工作表名并赋给变量
                wsName = .Name
                '如果变量flag值为False则执行条件语句
                If Not flg Then
                    '将打开的文件的第1个工作表中的第1行数据
                    '复制到开头新添加的Combined工作表第1行
                    .Rows(1).Copy ws.Cells(1)
                    '在Combined工作表中的开头插入一列
                    ws.Columns(1).Insert
                    '在插入的列的首行输入"Sheetname"
                    ws.Cells(1).Value ="Sheet name"
                    '设置变量flag值为True
                    flg = True
                End If
                '获取新添加的Combined工作表第2列
                '最后一个数据单元格之后的空单元格
                '注意End属性后括号中的2表示最后单元格之后的单元格
                '若括号中的数字为1则表示最后数据单元格
                Set LastR =ws.Cells(Rows.Count, 2).End(xlUp)(2)
                '打开的工作簿第1个工作表中当前数据区域
                With.Range("A1").CurrentRegion
                    '除去标题行后的数据区域
                    With .Resize(.Rows.Count -1).Offset(1)
                        '复制到Combined工作表中
                        .Copy LastR
                        '偏移到第1列并将区域扩展到与相邻列已使用数据区域
                        '相同的行数.注意LastR(,0)的用法
                        'GetBasename方法获取文件路径的最后部分
                        '即工作簿文件名,不包含扩展名
                        LastR(,0).Resize(.Rows.Count).Value = _
                       CreateObject("Scripting.FileSystemObject").GetBasename(e)
                    End With
                End With
            End With
            '关闭要从中获取数据的工作簿文件
            .Close False
        End With
    Next
    '自动调整列宽
   ws.Range("A1").CurrentRegion.Columns.AutoFit
    '打开屏幕刷新
    Application.ScreenUpdating = True
    Set ws = Nothing
End Sub

代码遍历所选择的每个工作簿文件,将数据依次添加到新增加的工作表中,同时在工作表首列添加工作簿文件名。我对每行代码都进行了详细的注释,可以参照来理解代码。

有几句代码需要特别说明:

1.代码:

ws.Cells(Rows.Count, 2).End(xlUp)(2)

注意到最后的括号和放置在其中的数字2,这表明在工作表第2列中最后一个数据单元格之后的空单元格。如果将2修改为1,则表明是最后一个数据单元格。

2.代码:

LastR(, 0)

表明LastR代表的单元格左侧的相邻单元格。

3.代码:

CreateObject("Scripting.FileSystemObject").GetBasename(e)

中的GetBasename方法返回一个字符串,包含文件路径的最后部分,不包含扩展名。例如,若文件路径为“C:完美Excelexcelvba.xlsm”,则返回“excelvba”。

代码的图片版如下:

vba

0 人点赞