今天给大家介绍另外一种绝招!神技!彪悍的人生无需解释!
假设你有几十个甚至几百个工作簿,每个工作簿里有若干表(少则一个,多则十几个工作表,每个表的数据结构相同,数据记录条数不等),现在你需要把这些工作簿里的每个工作表里的数据,复制粘贴到一个新工作簿的一个空白表里。
如果你有300个工作簿,每个工作簿里有7个工作表。假设这2000多个工作表里的数据记录(记录条数总数最多不能超过104万行,因为xlsx格式的单表最多行数是1048576行)都被复制粘贴到一个新工作簿里的某个空白表里,如果纯粹手工复制粘贴,操作熟练快速,中间不出任何差错,我毛估时间至少得10-15个小时。
也就是说你可能得机械地复制粘贴1-2个工作日的上班时间,中间不能有任何错误,否则可能意味着要检查甚至重新复制粘贴。
想必,有很多朋友这么干过。这么做过的人,都明白,枯躁乏味,苦不堪言,但却又无能为力!
下面是案例背景。 有300个工作簿,每个工作簿大概3-6个工作表不等,数据记录都是500行。
这些工作簿存储在某盘文件夹“多工作簿多表超级汇集”下的子文件夹“明细表”里
下面是其中一个工作簿里的一个工作表数据,记录数有500条。↓
而汇总表就存在“多工作簿多表超级汇集”这个文件夹下,见下图
打开工作簿“汇总表.xlsxm” (带VBA程序的excel工作簿应该保存为这种格式)
先学习第一种方法,在“总表”这个工作表里设置好表头,调整好列宽和格式,绘制好圆角矩形作为宏代码的执行按钮。
按ALT F11,插入,模块,把以下代码复制到模块1里
Sub 汇总不带表名() Dim wb, mypath, myfile, sh, zong t = Timer '开始时间 Set zong = Sheets('总表') zong.UsedRange.Offset(1, 0).ClearContents mypath = ThisWorkbook.Path & '\明细表\' myfile = Dir(mypath & '*.xlsx') Do While myfile <> '' Set wb = GetObject(mypath & myfile) For Each sh In wb.Worksheets On Error Resume Next With sh .UsedRange.Offset(1, 0).Copy zong.Cells(Range('a' & Rows.Count).End(xlUp).Row 1, 1) End With Next wb.Close False myfile = Dir Loop Set wb = Nothing MsgBox '数据合并用时:' & Format(Timer - t, '#0.000') & ' 秒', , '则见温馨提示:汇总完成!每一天都是美妙的!' End Sub
然后,关闭vba编辑窗口。右键单击按钮,指定宏,选择“汇总不带表名”,确定。
单击“提取”按钮,程序开始执行,大约6-7秒时间汇总完毕。时间长短取决于电脑内存以及汇总的工作表的数量(这里为了简化起见,只保留了7个工作簿,所以时间比较短,只有几秒钟)。
“总表”里的结果,是通过代码把各个表里的数据直接粘贴过来,没有考虑每个工作表的表名。 接下来再介绍一种vba写法,很多写法和上一种类似,就是加了增加表名作为列字段。
Sub 汇集带表名() Dim wb, hui, mypath, myfile, sh, myirow, newirow t = Timer '开始时间 Set hui = Sheets('汇集') hui.UsedRange.Offset(1, 0).ClearContents mypath = ThisWorkbook.Path & '\明细表\' myfile = Dir(mypath & '*.xlsx') Do While myfile <> '' Set wb = GetObject(mypath & myfile) For Each sh In wb.Worksheets On Error Resume Next With sh myirow = hui.Range('B' & Rows.Count).End(xlUp).Row 1 .UsedRange.Offset(1, 0).Copy hui.Cells(myirow, 2) newirow = hui.Range('B' & Rows.Count).End(xlUp).Row hui.Range('A' & myirow & ':A' & newirow) = sh.Name End With Next wb.Close False myfile = Dir Loop Set wb = Nothing MsgBox '数据合并用时:' & Format(Timer - t, '#0.000') & ' 秒', , '则见温馨提示:汇总完成!每一天都是美妙的!' End Sub
其他细节略。
点击“超级汇”按钮,大概3分钟不到执行完毕。
执行时间总共160多秒。因为这里测试用到的要提取数据的工作簿个数是300个(工作表总数大概2000个)。
最后提取的记录数右789000行。
复制粘贴2000个工作表到一个总表里来,不过3分钟! 提醒下,是从300个工作簿里,复制粘贴到“汇集”表里的! 提醒下,“汇集”总表里,还增加一列城市字段,其实就是2000个工作表的表名! 如果全部靠人工来复制粘贴,那么15个小时-20个小时是跑不掉的! 而且做这个工作的人,简直痛不欲生,无语凝噎,估计双手都得抽筋! 但是,我们这段代码,只需要3分钟! 只需要180秒! 只需要180秒! 只需要180秒! 再不学习,还想又快又好,还想升职加薪,简直痴人说梦!
|