3分钟完成年数据汇总，做完了帮帮你正在苦恼的同事吧

2022-11-17 02:01:21 网站优化 ℃

　　今天有粉丝问小编，年底了要汇总整年的数据头大怎么办，不要怕今天就叫你们如何使用vba进行多表以及多工作薄汇总，看不懂没关系，只要跟着做就可以了，以前几个小时才能完成的工作现在分分钟就完成了，别提多高兴了，

　　wps也没关系文章评论区我会给出wps开启开启vb编辑器的方法

　　使用代码有一个条件就是表格的格式必须一致，如果不一致的话需要更改为一致再使用

　　话不多说开干

　　一、多表汇总，比较适合你将全年的数据都放在一个工作薄中的不同工作表中

　　代码如下

　　Option ExplicitFunction lastrow(sh As Worksheet) As Long lastrow = sh.Cells(Rows.Count, 1).End(xlUp).RowEnd FunctionSub 多工作表汇总() Dim sh As Worksheet Dim DestSh As Worksheet Dim last As Long Dim copyRng As Range Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("汇总表").Delete On Error GoTo 0 Application.DisplayAlerts = True Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "汇总表" For Each sh In ActiveWorkbook.Worksheets If sh.Name <> DestSh.Name Then last = lastrow(DestSh) Set copyRng = sh.UsedRange If last + copyRng.Rows.Count > DestSh.Rows.Rows.Count Then MsgBox "汇总行数超过工作表最大行数" Exit Sub End If copyRng.Copy DestSh.Cells(last + 1, "A").PasteSpecial End If Next DestSh.Columns.AutoFit Application.ScreenUpdating = TrueEnd Sub1.复制代码

　　2.我们点击开发工具然后Visual Basic

　　点击去我们会进入vba编辑界面，问你选择插入，模块然后直接关闭，点击宏，选择多表汇总直接运行即可动图如下

　　当运行完成后会生成汇总表，只需要通过筛选即可将表头筛选出来，然后进行数据透视之类的计算

　　二、多薄汇总，适合你将全年的数据分别放在不同的工作薄中

　　代码如下

　　Sub 合并工作薄() Dim SummarySheet As Worksheet Dim SelectedFiles() As Variant Dim Nrow As Long Dim FileName As String Dim NFile As Long Dim WorkBk As Workbook Dim SourceRange As Range Dim DestRange As Range Set SummarySheet = ThisWorkbook.Worksheets(1) SelectedFiles = Application.GetOpenFilename(filefilter:="Excel 文件(*.xl*),*.xl*", MultiSelect:=True) Nrow = 1 For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) FileName = SelectedFiles(NFile) Set WorkBk = Workbooks.Open(FileName) Set SourceRange = WorkBk.Worksheets(1).UsedRange Set DestRange = SummarySheet.Range("A" & Nrow) Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count) DestRange.Value = SourceRange.Value Nrow = Nrow + DestRange.Rows.Count WorkBk.Close savechanges:=False Next SummarySheet.Columns.AutoFit End Sub1.新建汇总表