巧用WINRAR+VBA快速合并汇总文件夹下多簿多表

      审计工作中时常会碰到被审计单位提供的电子数据通过多级文件夹、工作簿和工作表来区分（图1）。以笔者示例数据为例，一个文件夹下分年、月、资金性质建有多级文件夹，每个末级文件夹下有3个EXCEL工作簿，每个工作簿中有19个工作表，但部分工作簿、工作表不需要参与合并汇总。常用汇总工具往往只能解决单一类别数据，费时费力。笔者巧用WINRAR+VBA实现自动排除不需要工作簿、表，对文件夹下多簿多表快速合并汇总，并同时自动添加相关文件信息，便于后期数据整理，极大地提高了工作效率。

      

      一、巧用WINRAR解决文件夹层级及排除部分工作簿问题

      （一）将待整理的数据先用WINRAR生成压缩包（以2016年农村五保为例）。

      （二）双击打开压缩包，在“解压到—高级”中选择“不解压路径”。勾选“要排除的文件列表”，并输入要排除文件“*资金*.xls”（图2）。

      

      （三）点“确定”，可以看到已经去掉文件夹，并排除了指定工作簿（如图3）。

      

      二、编写VBA语句快速合并文件夹下多簿多表并添加指定数据项

      （一）打开VBA编程界面。在需要进行整理的文件夹下建立一个EXCEL工作簿，打开新建的EXCEL工作簿，在“开发工具”中打开VBA编程界面，并选择“插入”——“模块”（图4）。

      

      （二）VBA语句。在VBA编程窗口输入以下语句，选择“运行”——“运行子过程/用户窗体”或者按“F5”，执行该VBA程序，输入表头所在行数，即可看见执行结果（图5）。

      

      Sub快速合并文件夹下多簿多表O

      Dim MyPath,MyName,AWbName

      Dim Wb As Workbook,WbN As String

      Dim G As Long,i As Integer,j As Integer,k As Integer

      Dim Num As Long,S As Long

      Dim BOX As String

      Application.ScreenUpdating=False

      ＇表头所在行数

      k=InputBox（＂请输入表头所在行数：＂）

      ＇获取数据源的路径和文件名

      MyPath=ActiveWorkbook.Path

      MyName=Dir（MyPath&＂/＂&＂*.xls＂）

      ＇用于汇总的工作簿文件名

      AWbName=ActiveWorkbook.Name

      Num=0

      ＇用于对数据源进行循环

      Do While MyName<>＂＂

      If MyName<>AWbName Then

      ＇打开数据源文件

      Set Wb=Workbooks.Open（MyPath&＂/＂&MyName）

      Num=Num+1

      With Workbooks（1）.ActiveSheet

      ＇对工作表进行循环操作

      For G=1 To Sheets.Count

      If Wb.Sheets（G）.Name<>＂汇总＂Then

      S=S+1

      ＇数据源所占的行列数

      i=Wb.Sheets（G）.UsedRange.Rows.Count

      j=Wb.Sheets（G）.UsedRange.Columns.Count

      ＇复制数据源的表头，d1为数据起始位置

      Wb.Sheets（G）.Cells（k,1）.Resize（1,j）.Copy.Range（＂d1＂）

      ＇添加的关于工作表相关信息

      .Range（＂a1＂）=＂文件名＂

      .Range（＂b1＂）=＂表名＂

      .Range（＂c1＂）=＂行数＂

      ＇存放文件名、表名及行数，便于后期进一步整理、核对

      .Cells（.Range（＂D＂& Rows.Count）.End（xlUp）.Row+1,1）=Left（MyName,Len（MyName）-4）

      .Cells（.Range（＂D＂& Rows.Count）.End（xlUp）.Row+1,2）=Wb.Sheets（G）.Name