精华内容
下载资源
问答
  • 可以通过该工作簿的代码修改成自己想要的工作簿,方便以后每次汇总多个工作簿
  • 1.同一目录下的工作簿,每个工作簿中有一张或工作表,一键全部汇总 Sub 合并目录所有工作簿全部工作表() Dim MP, MN, AW, Wbn, wn Dim Wb As Workbook Dim i, a, b, d, c, e Application.ScreenUpdating...

    1. 同一目录下的多工作簿,每个工作簿中有一张或多张工作表,一键全部汇总

    Sub 合并目录所有工作簿全部工作表()
    
    Dim MP, MN, AW, Wbn, wn
    
    Dim Wb As Workbook
    
    Dim i, a, b, d, c, e
    
    Application.ScreenUpdating = False
    
    MP = ActiveWorkbook.Path
    
    MN = Dir(MP & "\" & "*.xls")
    
    AW = ActiveWorkbook.Name
    
    Num = 0
    
    e = 1
    
    Do While MN <> ""
    
    If MN <> AW Then
    
    Set Wb = Workbooks.Open(MP & "\" & MN)
    
    a = a + 1
    
    With Workbooks(1).ActiveSheet
    
    For i = 1 To Sheets.Count
    
    If Sheets(i).Range("a1") <> "" Then
    
    Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)
    
    d = Wb.Sheets(i).UsedRange.Columns.Count
    
    c = Wb.Sheets(i).UsedRange.Rows.Count - 1
    
    wn = Wb.Sheets(i).Name
    
    .Cells(1, d + 1) = "表名"
    
    .Cells(e + 1, d + 1).Resize(c, 1) = MN & wn
    
    e = e + c
    
    Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)
    
    End If
    
    Next
    
    Wbn = Wbn & Chr(13) & Wb.Name
    
    Wb.Close False
    
    End With
    
    End If
    
    MN = Dir
    
    Loop
    
    Range("a1").Select
    
    Application.ScreenUpdating = True
    
    MsgBox "共合并了" & a & "个工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示"
    
    End Sub
    
    

    2. 同一工作簿中的多工作表,将指定的多工作表一键汇总

    Sub huizongdata()
    
        Rows("2:10000").Clear
         '第一步是先清空汇总表的数据,这里是从第2行开始清理到10000行,可以自己修改。
         
        Application.Wait Now + TimeValue("00:00:01")   '延迟1秒
        
        Dim st As Worksheet, rng As Range, rrow As Integer, i As Integer
        
        '定义一些需要用到的变量
        
        'For Each st In Worksheets  循环开始,遍历所有的工作表
        For i = 3 To Worksheets.Count
        
            Set st = Sheets(i)
            
            Set rng = Range("A10000").End(xlUp).Offset(1, 0)
            
            '每次循环就动态定位需要拷贝数据的区域,即获得A列第一个空的单元格
            
            rrow = st.Range("A2").CurrentRegion.Rows.Count - 1
            
            '获得每个工作表中的数据记录数,即行数,同时需要减去表头的行数,这里是减掉2行。
            
            st.Range("A2").Resize(rrow, 9).Copy rng
            
            '将数据扩展rows行,4列拷贝到数据,并粘贴到汇总表
        
        Next i
       
    
    End Sub
    

     

    展开全文
  • 工作簿多工作表的数据汇总 目标 excel中表单据中特定cell中的内容汇总成数据条。 demo分解 在实例1.1的基础上需要对工作簿进行操作。 依次打开工作簿用到了Dir()函数 ...

    实例

    多工作簿多工作表的数据汇总

    目标

    excel中多表单据中特定cell中的内容汇总成数据条。

    demo分解
    1. 在实例1.1的基础上需要对工作簿进行操作。
    2. 依次打开工作簿用到了Dir()函数
    3. 因为不在统一工作簿内,需要对targetbook和activeworkbook辨别
    文件不知怎们上传demo文件知道的留言一下
    技术思辨
    1. 主要在于dir函数在do循环下的结合。

    代码示例

    Option Explicit
    
    Sub subroutine1()
        Dim r, c, count As Integer
        r = 5   '规定起始行
        Rows(r & ":65536").Delete '清除数据
        
        Dim targetSheet As Worksheet
        Set targetSheet = Sheet2
        count = targetSheet.Cells(3, 3).End(xlToRight).Row
        Dim filename, filepath
        filepath = ThisWorkbook.Path
        filename = Dir(filepath & "\*.xlsx")
        Do Until filename = ""
            Workbooks.Open filepath & "\" & filename
            filename = Dir
            Dim sht As Worksheet
            For Each sht In Worksheets
                targetSheet.Cells(r, 1).Value = ActiveWorkbook.Name
                targetSheet.Cells(r, 2).Value = ActiveSheet.Name
                Dim I As Variant
                For I = 3 To count + 2
                    targetSheet.Cells(r, I) = ActiveSheet.Range(targetSheet.Cells(3, I).Value).Value
                Next I
                r = r + 1
            Next sht
            ActiveWorkbook.Close False
        Loop
    End Sub

     

    展开全文
  • 多工作簿多个工作表,全部数据汇总(工作簿内多个工作表,每个的格式,标题相同)
  • 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代码实现以下功能(我简化了要求):一个中有很多个excel文件,每个文件有类似的表格,代码实现把每个文件的表格复制到另一个excel文件中。折腾开始...... 之前没搞过VBA,我用的是wps抢...
  • vba汇总多个工作表,并新增一列记录各个数据所在的表名
  • VBA一键汇总多个工作簿-名称相同的工作表-的指定区域数据 日常工作,我们经常需要汇总相同格式的工作簿的某个工作表的数据 如1月业绩、2月业绩。。。。12月业绩等 姓名 数量 数据22 22 数据23 23 ...

    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

    我的窗体界面是这样的

     

    希望大家多多支持!谢谢

    展开全文
  • 多个Excel工作簿汇总到一个工作表,可以使用VBA,也可以使用power query。
  • 自己学习VBA编程时,利用excel内VBA宏编写的简单命令,涉及一些基础的操作,亲测可用,初学者可以借鉴,也能利用其解决一些简单的办公问题。
  • Sub 工作表中成绩汇总() Dim Z, H2, B 'Z总分;H2行;B工作表 Dim C1 As Worksheet 'C1为新的工作表 For B = 1 To Worksheets.Count 'B代表工作表,每一张工作表循环一次。 Set C1 = Worksheets(B) Z = 0 '...
  • Sub 如何使用VBA进行多表汇总() Dim AdoConn As New ADODB.Connection Dim AdoRst As ADODB.Recordset Dim strConn As String Dim strSQL As String Application.ScreenUpdating = False '设置连接字符串 ...
  • 原表格用于公司员工的工资表格,工资项目合并在一起并删除一些指定不要的项目,通过vba的宏运行快速表格数据重新关联筛选、计算、合并
  • 為了呈現完整數據或圖表,將所有工作表的數據會整至同一個工作表是常用需求。 %使用條件: 1.各工作表的標籤欄位名稱和數量一致 2.請勿更改該程式檔名 %使用方法: 1.點擊Worksheet combination按鈕。 2.選擇欲...
  • 工作簿指定工作表,全部数据汇总
  • 参考: VBA 合并同文件夹下工作簿中同名工作表到 一工作簿一工作表 在原先代码的基础上修改,可以自由选择和输入要合并工作簿的同文件夹和工作表名,并生成目录页。 效果展示: 1、选择工作表 2、输入指定相同...
  • 在一些操作中,往往会需要将多个工作簿进行合并。一般的操作方法都是打开两个工作簿,然后选中需要移动的工作表,右键单击以后选择“移动或复制”。接下来在新的窗口里面进行设置就可以了。这种方法适合在移动数量较...
  • 前言:此程序是将多个工作簿汇总至主工作簿的多个工作表中,且每个工作表的name是对应的工作簿的name。 Sub 批量合并workbook至主workbook的多个worksheet中() '1.批量打开文件,将文件路径记录到数组f中 f = ...
  • 使用vba操作工作表,实现报表汇总

    千次阅读 2020-07-07 10:53:49
    有哪些方法和属性?...重命名只是给sheet2起一别名 Sheets(2).select //sheets(2)指工作簿的第2张表 Sheets(“2月”).Select // Sheets(“2月”)指重命名为2月的 如何知道工作簿中有多少张表?
  • 利用Excel进行数据处理分析时,常需要对大量独立的具有相同表结构的原始工作薄中的数据进行汇总合并到一个工作薄的指定工作表中。通过VBA编程调用Excel对象在不打开源工作薄的情况下,将指定文件夹中所有工作薄中的...
  • 在工作中,我们经常遇到工作表合并到一张工作表的问题,比如希望将图1所示中各分表中保存的成绩记录,汇总到工作簿中的"成绩表"工作表中,可以用图2下面的程序。 图1 七(3)班工作表中的成绩记录 图2汇总...
  • 将总数据表进行拆分至多个工作表问题使用For循环拆分工作表使用筛选拆分工作表结果图 问题 将数据表中数据根据所属部门分配至对应部门的工作表内,如下图所示: 使用For循环拆分工作表 Sub shishi() Dim sht As ...
  • 1、所有要汇总的工作簿在同一文件夹中,这里以后缀为.xlsx为例; 2、需要合并的工作表名称相同(如: “sheet1”),且数据字段一样(如:A列表示序号,B列表示姓名,C列表示月工资等); 3、需要合并的数据所在...
  • '功能:把多个工作簿的第一个工作表合并到一个工作簿的多个工作表,新工作表的名称等于原工作簿的名称 Sub Books2Sheets() '定义对话框变量 Dim fd As FileDialog Set fd = Application.FileDialog...
  • 在Excel中使用VBA将所有sheet中的数据和sheet信息汇总到总中的例子,使用VBA编写,在第一sheet中的宏check,使用时需要打开excel的宏安全,执行时会在合计页填充所有其他sheet的sheet名称,链接,编号,合计...
  • 这是一个常用而且经典的例子:根据内容,把N个工作表中的内容,合并到一个工作表中; ¤主要知识点¤ 1、工作表选取和内容的复制; 2、IF分支语句和For循环语句的使用; ¤代码实例¤ Option Explicit Sub ...
  • 如图所示,该工作簿中包含若干个工作表,工作表中为各个学校书籍销售明细。如 何使用VBA按其工作表中的图书名称汇总各种图书的数量? 示例数据表 序号 图书名称 版 别 年版 定价 适读范围 订数...
  • excel中vba下的代码,合并当前文件夹下所有excel工作表到一新建的工作表中,并将合并的数据进行横向铺开排列。
  • 今天将大家用VBA一键合并,只需要几秒种,为了测试这段代码,我们新建了4个工作簿在文件夹中,数据都是模拟的,做试验一键合并代码操作如下所示:我们看原始表格数据,其中,第1个工作簿有点特殊,这个工作簿中,有...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 1,384
精华内容 553
关键字:

vba汇总多个工作表