资源描述：
《用vba提取word表格数据到excel》由会员上传分享，免费在线阅读，更多相关内容在应用文档-天天文库。
1、用VBA提取Word表格数据到Excel我公司有职工7000多人，公司举行申请入会表格就有6000多份，公司要求把申请表的数据提取出来进行分类统计，如果手工操作那可累坏我们科室这几号人，而且时间紧，没办法，赶紧连夜搞了一个VBA程序进行处理，几分钟就搞定了。程序今分享如下：PublicSubxlss()DimexlappAsObjectDimwbookAsObjectDimshtAsObjectDimsAsString,tAsString,uAsStringDimiAsInteger,jAsInteger,kAsIntegerSetexlapp
2、=CreateObject("excel.Application")Setwbook=exlapp.Workbooks.AddSetsht=wbook.Sheets(1)exlapp.Visible=True'提取表格数据sht.Cells(1,1)="序号"sht.Cells(1,2)="姓名"sht.Cells(1,3)="性别"sht.Cells(1,4)="出生年月"sht.Cells(1,5)="籍贯"sht.Cells(1,6)="政治面貌"sht.Cells(1,7)="学历、学位"sht.Cells(1,8)="专业"sht.C
3、ells(1,9)="毕业院校"sht.Cells(1,10)="工作年限"sht.Cells(1,11)="参加工作时间"sht.Cells(1,12)="职务"sht.Cells(1,13)="职称评定时间"sht.Cells(1,14)="专业职称级别"sht.Cells(1,15)="特长"sht.Cells(1,16)="通讯地址"sht.Cells(1,17)="联系方式"k=ActiveDocument.Tables.Count'表格份数Fori=1Toksht.Cells(i+1,1)=Str$(i)t=Trim(ActiveD
4、ocument.Tables(i).Cell(1,2).Range)'假设名称在表格第一行第二列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,2)=tt=Trim(ActiveDocument.Tables(i).Cell(1,4).Range)'假设名称在表格第一行第四列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,3)=tt=Trim(ActiveDocument.Tables(i).Cell(2,2).Range)'假设名称在表格第二行第二列u=Mid(t,1,L
5、en(t)-2)t=Trim(u)sht.Cells(i+1,4)=tt=Trim(ActiveDocument.Tables(i).Cell(2,4).Range)'假设名称在表格第二行第四列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,5)=tt=Trim(ActiveDocument.Tables(i).Cell(3,2).Range)'假设名称在表格第三行第二列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,6)=tt=Trim(ActiveDocument.Ta
6、bles(i).Cell(3,4).Range)'假设名称在表格第三行第四列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,7)=tt=Trim(ActiveDocument.Tables(i).Cell(4,2).Range)'假设名称在表格第四行第二列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,8)=tt=Trim(ActiveDocument.Tables(i).Cell(4,4).Range)'假设名称在表格第四行第四列u=Mid(t,1,Len(t)-2)t=
7、Trim(u)sht.Cells(i+1,9)=tt=Trim(ActiveDocument.Tables(i).Cell(5,2).Range)'假设名称在表格第五行第二列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,10)=tt=Trim(ActiveDocument.Tables(i).Cell(5,4).Range)'假设名称在表格第五行第四列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,11)=tt=Trim(ActiveDocument.Tables(i).
8、Cell(6,2).Range)'假设名称在表格第六行第二列u=Mid(t,1,Len(t)-2)t=Trim(u)sht.Cells(i+1,12)
