精华内容
下载资源
问答
  • vba汇总多个工作表,并新增一列记录各个数据所在的表名
  • 可以通过该工作簿的代码修改成自己想要的工作簿,方便以后每次汇总多个工作簿
  • 有时后我觉得自己 像一只小小鸟 想要飞 却怎么...今天再来聊下如何汇总多个工作簿首个工作表的数据到总表。这事儿常用的方法有三种,一种是SQL语句,一种是Power Query,还有一种就是VBA了。相比前两种方法,VBA有更...

    有时后我觉得自己 像一只小小鸟 想要飞 却怎么样也飞不 也许有一天我栖上枝头 却成为猎人的目标……


    诸君好,我是星光,之前咱们聊了如何汇总指定文件夹下多个工作簿全部工作表的数据到总表:合并多工作簿数据成总表?只需一键!
    今天再来聊下如何汇总多个工作簿首个工作表的数据到总表。

    这事儿常用的方法有三种,一种是SQL语句,一种是Power Query,还有一种就是VBA了。相比前两种方法,VBA有更好的灵活性。我举个野生小栗子,它可以允许标题行存在合并单元格,可以允许标题行存在多行,允许标题的字段不一样多,甚至可以允许分表区域有乱七八糟的合并单元格……等等。更别提VBA拥有优秀的交互性,比如下图所示允许用户在对话框中自定义标题行的行数。37e341bd0850fa75f6b4a25b51eb8fe9.gif

    代码如下:

    代码如看不全,可以左右拖动..

    Sub CollectWKSheetOne()
        Dim lngHeadLine As Long, k As Long
        Dim arr, brr
        Dim i As Long, j As Long, lngShtCount As Long
        Dim strPath As String, strWKName As String
        Dim rngData As Range, n As Long
        With Application.FileDialog(msoFileDialogFolderPicker)
        '取得用户选择的文件夹路径
            If .Show Then strPath = .SelectedItems(1) Else Exit Sub
        End With
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        lngHeadLine = Val(InputBox("请输入标题的行数", "提醒", 1))
        If lngHeadLine < 0 Then MsgBox "标题行数不能为负数。", 64, "亲": Exit Sub
        Application.ScreenUpdating = False '关闭屏幕更新
        Cells.Clear '清空当前表数据
        Const DATA_MAXROW As Long = 80000
        '结果数组最大行数
        ReDim brr(1 To DATA_MAXROW, 1 To 1)
        '定义汇总结果的数组brr,最大行数为8万行
        strWKName = Dir(strPath & "*.xls*")
        '开始遍历指定文件夹路径下的Excel工作簿
        Do While strWKName <> ""
            If strPath <> ThisWorkbook.Name Then '避免同名文件重复打开出错
                With GetObject(strPath & strWKName)
                '以\'只读\'形式读取文件时,使用getobject方法会比workbooks.open稍快
                    Set rngData = .Worksheets(1).UsedRange
                    If IsEmpty(rngData) = False Then '如果工作表非空
                        lngShtCount = lngShtCount + 1 '标记一下汇总工作表的个数
                        arr = rngData.Value '数据区域读入数组arr
                        If UBound(arr, 2) > UBound(brr, 2) Then
                        '动态调整结果数组brr的最大列数,避免明细表列数不一的情况。
                            For j = UBound(brr, 2) To UBound(arr, 2)
                            '将新增的标题写入汇总表
                                For i = 1 To lngHeadLine
                                    Cells(i, j).Value = arr(i, j)
                                Next
                            Next
                            ReDim Preserve brr(1 To UBound(brr), 1 To UBound(arr, 2))
                        End If
                        For i = lngHeadLine + 1 To UBound(arr) '遍历数据区域的行
                            k = k + 1 '累加记录条数
                            For j = 1 To UBound(arr, 2) '遍历列
                                brr(k, j) = "'" & arr(i, j) '全部转换为文本,避免数值变形
                            Next
                            If k = DATA_MAXROW Then
                            '如果数据到达结果数组的上限,则读入表格,腾出空间,以便装新的数据
                                Range("a1").Offset(lngHeadLine + n).Resize(k, UBound(brr, 2)) = brr
                                n = n + DATA_MAXROW
                                ReDim brr(1 To DATA_MAXROW, 1 To UBound(brr, 2))
                                k = 0
                            End If
                        Next
                    End If
                    .Close False '关闭工作簿,不保存。
                End With
            End If
            strWKName = Dir '同路径下的下一个excel工作簿
        Loop
        If k > 0 Then
            Range("a1").Offset(lngHeadLine + n).Resize(k, UBound(brr, 2)) = brr
            MsgBox "汇总完成,一共汇总:" & lngShtCount & "张表。"
        End If
        Application.ScreenUpdating = True '恢复屏幕更新
    End Sub
    代码三五行,工作不用忙断肠,你也试一下吧。

    更多资源和教程

    • 零基础学SQL in Excel 25篇合集

    • VBA爱好者请进,VBA代码宝概述


    ©EH看见星光

    a77abd03b75c38cb8984e33e416eb02c.png

    《VBA经典代码应用大全》当当、天猫、京东均有销售~
    展开全文
  • 在每个工作表中,都有对应的内容,格式都是一致的。现在要将这些详细工作表同一位置A2:B2的内容都放入Sheet1中,并且是按行填入。如果工作表很的话,手动输入就比较麻烦,下面就介绍一下使用VBA来处理这样的表格。...

    如图,现在有这样一个工作簿,里面有一些工作表。

    aeb455c489663ad0f72f09c01c21ac90.png

    在每个工作表中,都有对应的内容,格式都是一致的。

    cadf9e24a4df0aec600d2b6f66191b9e.png

    现在要将这些详细工作表同一位置A2:B2的内容都放入Sheet1中,并且是按行填入。

    71fdde2f76dc21e6ed4dde5f34ae9e14.png

    如果工作表很多的话,手动输入就比较麻烦,下面就介绍一下使用VBA来处理这样的表格。

    VBA代码如下:

    Sub Collection()

    Worksheets("Sheet1").Activate

    Dim i As Integer, j As Integer

    j = 2

    For i = 2 To Worksheets.Count

    Worksheets(i).Range("A2:B2").Copy

    Worksheets("Sheet1").Range("A" & j & ":B" & j).Select

    ActiveSheet.Paste

    j = j + 1

    Next i

    Application.CutCopyMode = False

    Range("A1").Select

    End Sub

    5c1e8648985e56f899ccbb7ca1892ccd.png

    点击运行之后,对应的内容就会都出现在Sheet1中了。

    94ddf197260c0935662c0d84a2482936.png

    这样就比较快速方便。当然了,在实际工作中,相关的数据或者信息会更加复杂,可以根据实际情况来进行调整。例如修改目标的单元格区域,在填入的单元格需要注意设置好新的范围,避免后面数据填入以后出现叠加覆盖情况。

    想了解更多Excel的操作技巧,欢迎关注微信公众号:tobefascinating,一起学习,一起进步。

    展开全文
  • sub 汇总多个工作簿() Application.ScreenUpdating = False Dim wb As Workbook, f As String, l As String, n As String, m As String, j As Integer f = ThisWorkbook.Path & "\" l = f & "*.xls" ...

    sub 汇总多个工作簿()

    Application.ScreenUpdating = False

    Dim wb As Workbook, f As String, l As String, n As String, m As String, j As Integer

        f = ThisWorkbook.Path & "\"

        l = f & "*.xls"

        m = Dir(l)

        Do While m <> ""

            If m <> ThisWorkbook.Name Then

            n = f & m

            Workbooks.Open (n)

             With ThisWorkbook.activesheet

            .Range("b4:at34").ClearContents

            For i = 4 To .Range("a1").CurrentRegion.Rows.Count

            For j = 2 To .Range("a1").CurrentRegion.Columns.Count - 2 Step 3

            For Each wb In Workbooks

                If wb.Name <> ThisWorkbook.Name Then

                 aa = Left(wb.Name, InStrRev(wb.Name, ".") - 1)

                    If .Cells(2, j).Value = aa Then

                    .Cells(i, j) = Application.VLookup(.Cells(i, 1), wb.Worksheets(1).Range("a:b"), 2, 0)

                    .Cells(i, j + 1) = Application.VLookup(.Cells(i, 1), wb.Worksheets(1).Range("a:c"), 3, 0)

                        If VBA.IsNumeric(ThisWorkbook.activesheet.Cells(i, j + 1)) = False Then

                        ThisWorkbook.activesheet.Cells(i, j + 2) = 0

                        ElseIf ThisWorkbook.activesheet.Cells(i, j + 1) = 0 Then

                        ThisWorkbook.activesheet.Cells(i, j + 2) = 0

                        Else

                        ThisWorkbook.activesheet.Cells(i, j + 2) = ThisWorkbook.activesheet.Cells(i, j) / ThisWorkbook.activesheet.Cells(i, j + 1)

                        End If

                    End If

                End If

            Next

            Next

            Next

            End With

            End If

            m = Dir

        Loop

       For Each wb In Workbooks

        If wb.Name <> ThisWorkbook.Name Then

        wb.Close False

        End If

        Next

    Application.ScreenUpdating = True

    End Sub

     

     

    效果图:

    不足:

    调用excel本身的函数vlookup,数据量大的话,会导致运行速度慢,表格卡住的问题,后期优化,应用数组解决。

     

    转载于:https://www.cnblogs.com/susuye/p/7169209.html

    展开全文
  • 我用的还是这素材:汇总的目标是把各个省市的表汇总到一张上,用VBA最终的操作非常简单,点按钮的事,但编程要花点时间,如果这个汇总是周而复始或量比较大,建议用VBA编程,但如果量少且偶尔发生就按之前的...

    之前前给大家介绍过一种不用VBA就能实现汇总的方法,今天给大家介绍一下用VBA进行操作的汇总。

    我用的还是这个素材:

    汇总的目标是把各个省市的表汇总到一张表上,用VBA最终的操作非常简单,点个按钮的事,但编程要花点时间,如果这个汇总是周而复始或量比较大,建议用VBA编程,但如果量少且偶尔发生就按之前的方法做就可以了。

    先看效果,是不是很帅,就点了下按钮而已。

    0598593121f248a120feb4a62550c407.gif

    步骤其实很简单,跟着我来操作:

    1.在各省市的文件夹下面新建一个新的工作簿,然后ALT+F11打开VBA编程界面,记得把这个工作簿一定要设为启用宏的工作簿,文件后缀名是xlsm就没错了。

    2.然后选择插入-模块,双击模块,在弹出的框里输入以下程序。

    4806bdaa757c330b3150c46e949643e7.png

    其实这段代码的基础是在网上找的,然后根据我的底稿做了修改,我基本也在个程序语句后面都做了注释,也就是紫色的汉字。其实VBA没有想象的复杂,会一些简单的语句之后,其实是可以借助网上的一些资源加以修改后就能使用的,具体如下所示:

    Sub 汇总各省市()

    Dim r As Long

    r = 1 '标题性

    Range(Cells(r + 1, "A"), Cells(Rows.Count, "B")).ClearContents

    '清除数据后再复制,以免产生错误

    Application.ScreenUpdating = False

    '这个就是个关闭屏幕更新的,从名称也能看出来,主要是提高效率,省的晃眼睛,没啥实际操作动作

    Dim filename As String, wb As Workbook, sht As Worksheet, erow _As Long, fn As String, arr As Variant

    '对各变量的类型进行定义,主要是有些是文本,有些是数字等等,作用不同

    filename = Dir(ThisWorkbook.Path & "*.xls")

    '确定汇总表所在工作簿的文件夹路径,限定程序的范围

    Do While filename <> ""

    If filename <> ThisWorkbook.Name Then

    '判断文件是否为程序所在工作簿,不是的话就继续操作

    erow = Range("A1").CurrentRegion.Rows.Count + 1

    '这个是要找到从A1单元格连续的区域的最后一行后再加1,那就是非空行第一行

    fn = ThisWorkbook.Path & "" & filename

    Set wb = GetObject(fn)

    '将fn代表的工作簿对象赋给变量

    Set sht = wb.Worksheets(1)

    '汇总到第一张工作表

    arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(Rows.Count, _"B").End(xlUp).Offset(0, 2))

    '将数组arr中的数据写入工作表

    Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

    '给下一个赋值提供新的粘贴的位置信息,这样就能把各个文件中内容挨个填入汇总工作簿的工作表1中

    wb.Close False

    End If

    filename = Dir

    Loop

    Application.ScreenUpdating = True '打开屏幕更新

    End Sub

    3.加一个按钮,插入一个对象就行,比如图形、个人美照,开发工具中的按钮也行,反正看个人爱好,我就是插入-形状、选了个长方形,然后点击图形图片,鼠标点击右键选择指定宏,找到程序的名称“汇总各省市”选中,点击下方确定按钮就可以了。

    f282319d90844b6edbf7e9d7b709298a.png

    如果喜欢我的文章,欢迎关注微信公众号:跟我学EXCEL图表

    展开全文
  • 多个Excel工作簿汇总到一个工作表,可以使用VBA,也可以使用power query。
  • 1.同一目录下的工作簿,每个工作簿中有一张或工作表,一键全部汇总 Sub 合并目录所有工作簿全部工作表() Dim MP, MN, AW, Wbn, wn Dim Wb As Workbook Dim i, a, b, d, c, e Application.ScreenUpdating...
  • 1、需求:有1个工作簿,多个工作表,格式一致,按某列作为关键字(具有唯一性),汇总数据,以工作表名称作为汇总后的新列名称,并生成1列合计。2、实际例子:有1个记录员工工资的工作簿,姓名是唯一的,需要汇总每一...
  • 2、举例:假如你在1个大型集团公司人力部门工作,公司每年都要收集下属上百个子公司、及子公司的子公司的人员信息,这个工作落到你手上了。糟糕的是这么大的公司没有用系统来管理,必须让各个子公司报Excel表格。还...
  • 有很多小伙们一直在提问关于如果汇总多个工作表至一个工作表中,小必老师给大家整理了一下,给大家整理了三种通用的方法。这三种方法分别是:Power Query,SQL以及VBA。如下图所示,一个工作簿中有三个相同的工作表...
  • 前言:今天整理了一个汇总表,需要分部门在系统上...一、一个工作表拆分为多个工作表Sub CFGZB() Dim myRange As Variant Dim myArray Dim titleRange As Range Dim title As Variant Dim columnNum As Inte...
  • 大家好,今日讲解VBA数据库解决方案的第32讲,利用ADO,秒杀实现多个EXCEL工作表的数据的汇总。我曾经讲过:学以致用,如果我们学习了,没有利用,那么知识永远是知识,无法转换为我们实际的成果。所以我的资料中...
  • 今天就为朋友们分享一种单纯使用函数、不包含任何VBA代码快速汇总多个工作表数据的方法。一.实例要求及动态演示:1.在这个实例中需要把12个月份的工资表汇总到一张工作表里。2.动态演示:二.主要相关函数介绍汇总多...
  • Sub text1()Worksheet.Add....汇总"For Each Sheet In Worksheetsk = k + 1x = y.usedRange.Rows.Countsheets("汇总").Cells(k, 1) = Sheet.Namesheets("汇总").Cells(k, 2) =xNextEnd Sub
  • 大家好,今天继续讲解《VBA数据库解决方案》,今日讲解的是第37讲,利用ADO,实现同一文件夹下多个EXCEL工作表的数据汇总。最近的内容实用性比较强,如今日的内容,只把需要汇总的EXCEL文件放在同一个文件夹下,而且...
  • 工作中,我们除了将不同工作簿中的内容合并到一个工作簿外,在同一个工作簿中,也有将不同工作表进行合并的诉求,怎么将多个指定工作表合并(复制、带格式和公式)到同一个工作表(汇总表)中呢,我给大家分享下我的逻辑...
  • 在这之前先明确两名词 “工作表”和“工作簿”,工作表这里指的是EXCEL文件,工作簿指的是工作表里的sheet1,sheet2之类的。工作簿工作表因为有的地方这两是反过来的。先看一下汇总效果一键汇...
  • 前言:此程序是将多个工作簿汇总至主工作簿的多个工作表中,且每个工作表的name是对应的工作簿的name。 Sub 批量合并workbook至主workbook的多个worksheet中() '1.批量打开文件,将文件路径记录到数组f中 f = ...
  • 今天就为朋友们分享一种单纯使用函数、不包含任何VBA代码快速汇总多个工作表数据的方法。一.实例要求及动态演示:1.在这个实例中需要把12个月份的工资表汇总到一张工作表里。2.动态演示:二.主要相关函数介绍汇总多...
  • 需求:最近工作需要将多个采购单的数据汇总到一张中查看,因为每张采购单格式相同,且每个采购单对应一个sheet,现在想把张三明细、李四明细中的每月采购总额、期初应付款余额、供应商名称等汇总到一张sheet中,...
  • 今天将大家用VBA一键合并,只需要几秒种,为了测试这段代码,我们新建了4个工作簿在文件夹中,数据都是模拟的,做试验一键合并代码操作如下所示:我们看原始表格数据,其中,第1个工作簿有点特殊,这个工作簿中,有...
  • 举个栗子,如下图,一个工作簿,包含多个工作表,现在需要将各个分表的数据汇总到总表中。碰到这样的问题,有些小伙伴会想到使用数据透视表或者合并计算等方式进行操作。但这两种操作方式都有它的局限性。比如说,...
  • 代码分为三部分: 第一部分是新建一个汇总的工作表,并重新自定义命名; 第二部分是逐一将各个工作表复制粘贴到汇总工作表中;...Worksheets.Add '新建一个工作表 Sheets(1).Name = "汇总工作表" ...
  • 我们需要将1月、2月、3月、4月这四名称命名的四工作表的数据,合并汇总到我们的汇总表中。一般大家都会想到用复杂的函数公式或者是vba代码的方式来进行数据汇总,今天我们就来学习在不使用函数公式及vba代码的...
  • 今天教大家如何用VBA代码,一键汇总多工作表数据。一、问题场景:如上图: 我们平时登记员工的考勤数据的时候,会按照每页每页的登记,现在我们需要将3月1日-3月4日每一页的这些数据汇总到一张表上面去。这...
  • 一个工作薄里多个工作表特定区域汇总程序 VBA程序汇编
  • 工作中,我们会遇到这样的场景,将多个工作表的内容合并到一个工作簿中(区别于昨天的内容:拆分工作簿),如果有这样的需求,请跟我一起来了解,怎么用VBA实现呢。1、先来说明使用前的注意事项这里是分别复制给子工作...
  • 它的主要功能是根据指定的多个(单或多甚至多工作簿)单元格区域进行合并计算,一般常用于多数据统计。比如下面这个小动画,5秒即可搞定多数据统计。嘿~!是不是很简便又很实用~我们现在的问题是,如何...

空空如也

空空如也

1 2 3 4 5 ... 11
收藏数 202
精华内容 80
关键字:

vba汇总多个工作表