用VBA提取Word表格数据到Excel.doc

用VBA提取Word表格数据到Excel我公司有职工7000多人，公司举行申请入会表格就有6000多份，公司要求把申请表的数据提取出来进行分类统计，如果手工操作那可累坏我们科室这几号人，而且时间紧，没办法，赶紧连夜搞了一个VBA程序进行处理，几分钟就搞定了程序今分享如下：Public Sub xlss()Dim exlapp As ObjectDim wbook As ObjectDim sht As ObjectDim s As String, t As String, u As StringDim i As Integer, j As Integer, k As IntegerSet exlapp = CreateObject("excel.Application")Set wbook = exlapp.Workbooks.AddSet sht = 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.Cells(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 表格份数For i = 1 To k sht.Cells(i + 1, 1) = Str$(i) t = Trim(ActiveDocument.Tables(i).Cell(1, 2).Range) 假设名称在表格第一行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 2) = t t = Trim(ActiveDocument.Tables(i).Cell(1, 4).Range) 假设名称在表格第一行第四列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 3) = t t = Trim(ActiveDocument.Tables(i).Cell(2, 2).Range) 假设名称在表格第二行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 4) = t t = Trim(ActiveDocument.Tables(i).Cell(2, 4).Range) 假设名称在表格第二行第四列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 5) = t t = Trim(ActiveDocument.Tables(i).Cell(3, 2).Range) 假设名称在表格第三行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 6) = t t = Trim(ActiveDocument.Tables(i).Cell(3, 4).Range) 假设名称在表格第三行第四列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 7) = t t = Trim(ActiveDocument.Tables(i).Cell(4, 2).Range) 假设名称在表格第四行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 8) = t t = Trim(ActiveDocument.Tables(i).Cell(4, 4).Range) 假设名称在表格第四行第四列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 9) = t t = Trim(ActiveDocument.Tables(i).Cell(5, 2).Range) 假设名称在表格第五行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 10) = t t = Trim(ActiveDocument.Tables(i).Cell(5, 4).Range) 假设名称在表格第五行第四列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 11) = t t = Trim(ActiveDocument.Tables(i).Cell(6, 2).Range) 假设名称在表格第六行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 12) = t t = Trim(ActiveDocument.Tables(i).Cell(7, 2).Range) 假设名称在表格第七行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 13) = t t = Trim(ActiveDocument.Tables(i).Cell(7, 4).Range) 假设名称在表格第七行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 14) = t t = Trim(ActiveDocument.Tables(i).Cell(8, 2).Range) 假设名称在表格第八行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 15) = t t = Trim(ActiveDocument.Tables(i).Cell(9, 2).Range) 假设名称在表格第九行第二列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 16) = t t = Trim(ActiveDocument.Tables(i).Cell(9, 4).Range) 假设名称在表格第九行第四列 u = Mid(t, 1, Len(t) - 2) t = Trim(u) sht.Cells(i + 1, 17) = t NextEnd Sub （注：文件素材和资料部分来自网络，供参考。

请预览后才下载，期待你的好评与关注。