VBA一键汇总多个工作簿-名称相同的工作表-的指定区域数据

VBA一键汇总多个工作簿-名称相同的工作表-的指定区域数据

日常工作,我们经常需要汇总相同格式的工作簿的某个工作表的数据

如1月业绩、2月业绩。。。。12月业绩等

姓名数量
数据2222
数据2323
数据2424
数据2525
数据2626
数据2727
数据2828
数据2929
数据3030
数据3131
数据3232
数据3333
数据3434
数据3535
数据3636
数据3737
数据3838
数据3939
数据4040

VBA汇总后变成这样:

 啥也不说了,直接拿代码去用

 Dim 所有工作簿列表 As FileDialogSelectedItems
    Private Sub 提取数据按钮_Click(sender As Object, e As EventArgs) Handles 提取数据按钮.Click


        Dim dic As Object = CreateObject("scripting.dictionary")
        Dim wb As Excel.Workbook
        Dim sht As Excel.Worksheet
        Dim j As Long

        With App.FileDialog(Microsoft.Office.Core.MsoFileDialogType.msoFileDialogFilePicker)
            .AllowMultiSelect = True
            .Title = "可选择多个工作簿"

            If .Show() = -1 Then
                所有工作簿列表 = .SelectedItems              '记录所有工作簿,防止二次选择工作簿
                For Each 工作簿路径 As String In .SelectedItems

                    wb = App.Workbooks.Open(工作簿路径)
                    For Each sht In wb.Worksheets
                        dic(sht.Name) = ""
                    Next

                    wb.Close(False)
                Next

                '将所有表名加载
                For Each 表名 In dic.keys
                    ComboBox2.Items.Add(表名)           '适合汇总同工作表名称的汇总
                Next

            End If
        End With
    End Sub

    Private Sub 汇总数据按钮_Click(sender As Object, e As EventArgs) Handles 汇总数据按钮.Click
        Dim wb As Excel.Workbook
        Dim sht As Excel.Worksheet
        Dim j As Long


        Dim 开始输出单元格 As Excel.Range = App.InputBox("请选择开始输出单元格", Type:=8)
        Dim 输出表 As Excel.Worksheet = App.ActiveSheet

        For Each 工作簿路径 As String In 所有工作簿列表

            wb = App.Workbooks.Open(工作簿路径)
            For Each sht In wb.Worksheets
                If sht.Name = ComboBox2.Text Then
                    Dim lastrow As Long = 输出表.Cells(输出表.Rows.Count, 开始输出单元格.Column).end(Microsoft.Office.Interop.Excel.XlDirection.xlUp).row + 1      '最后一行
                    sht.Range(ComboBox3.Text).Copy(输出表.Cells(lastrow, 开始输出单元格.Column))      '尽量不要整列,否则可能出错
                End If
            Next

            wb.Close(False)
        Next
    End Sub

    Private Sub 选择单元格按钮_Click(sender As Object, e As EventArgs) Handles 选择单元格按钮.Click
        ComboBox3.Text = App.InputBox("请选择汇总区域", Type:=8).address
    End Sub

我的窗体界面是这样的

 

希望大家多多支持!谢谢

  • 10
    点赞
  • 41
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 8
    评论
VBA中,要汇总同一文件夹中多个工作簿中的同名工作,可以按照以下步骤进行: 首先,创建一个新的工作簿作为汇总结果。可以使用以下代码创建新的工作簿: ```vba Dim summaryWorkbook As Workbook Set summaryWorkbook = Workbooks.Add ``` 接下来,获取指定文件夹中的所有文件名。可以使用以下代码获取文件夹路径以及文件夹中的所有文件名: ```vba Dim folderPath As String Dim fileName As String Dim folder As Object Dim file As Object folderPath = "指定的文件夹路径" Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath) For Each file In folder.Files fileName = file.Name '在此处继续编写代码 Next file ``` 然后,打开每个工作簿,并将相应的同名工作复制到汇总结果工作簿中。可以使用以下代码实现: ```vba Dim sourceWorkbook As Workbook Dim sourceWorksheet As Worksheet Dim destWorksheet As Worksheet For Each file In folder.Files fileName = file.Name Set sourceWorkbook = Workbooks.Open(folderPath & "\" & fileName) For Each sourceWorksheet In sourceWorkbook.Worksheets '检查是否有同名工作 If WorksheetExists(sourceWorksheet.Name, summaryWorkbook) Then Set destWorksheet = summaryWorkbook.Worksheets(sourceWorksheet.Name) sourceWorksheet.Copy After:=destWorksheet End If Next sourceWorksheet sourceWorkbook.Close SaveChanges:=False Next file ``` 最后,在完成复制后,保存并关闭汇总结果工作簿: ```vba summaryWorkbook.SaveAs folderPath & "\汇总结果.xlsx" summaryWorkbook.Close SaveChanges:=False ``` 以上是利用VBA汇总同一文件夹中多个工作簿中同名工作的方法。通过遍历文件夹中的工作簿,打开每个工作簿并复制同名工作汇总结果工作簿中,最后保存并关闭汇总结果工作簿
评论 8
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

Excel_VBA创维大表格จุ๊บ

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值