多表汇总第3集：Word VBA汇总多表通用技巧

拥梦者 原创  补记于2016年12月20日16:30

【由于软件发布内容长度要求，特重新整理发布】

说明

有小伙伴说，如果我发出去和收回来的模板是Word表格，但是我就想汇总为Excel表格，这有解吗？答案是肯定的。就是总表的制作有别，其余皆可参考上面的方法。

注：操作演示为Office2010版，其余版本请参考使用。

图1.其余步骤请参考第2集，建立Excel空白表格，保存名称为“总表.xlsm”

图19.Excel总表VBA代码的建立

下面是VBA代码的文字版本，请复制后粘贴到模块中：

---

Sub汇总各分表()

DimDocAsObject,myDoc,a,d,i,str'创建一些变量。

Application.ScreenUpdating=False'关闭屏幕更新

SetDoc=CreateObject("Word.Application")'新建Word对象

Doc.Visible=True'可见

str=Dir(ThisWorkbook.Path&"\*.docx")'在当前路径下搜索扩展名为docx的文档，这个地方可以根据自己需要替换

DoWhileLen(str)<>0

i=i+1

SetmyDoc=Doc.Documents.Open(Chr(34)&ThisWorkbook.Path&"\"&str)'打开搜索到的文档

Forj=1TomyDoc.Tables(1).Rows.Count'建立表格的行数的循环

Fork=1TomyDoc.Tables(1).Columns.Count'建立表格列数的循环

IfAsc(myDoc.Tables(1).Cell(j,k).Range.Text)<>13Then'判断单元格如果不只是回车键就进行赋值操作

Sheet1.Cells(j,k).Value=WorksheetFunction.Clean(myDoc.Tables(1).Cell(j,k).Range.Text)'将非空单元格依次粘贴到总表对应的单元格中

EndIf

Next

Next

myDoc.Close'关闭搜索到的文档

str=Dir

Loop

Application.ScreenUpdating=True'启用屏幕更新

Doc.Quit'退出

EndSub

---

总表制作好后，参照前面运行宏即可坐等结果，效果如下图：

注：为了保持通用性，这个方法与上一种Word VBA的汇总处理方法在效率上是一致的。