如何提取word文档中多个简历信息至excel汇总表

hhjjpp

居然每个word表的行数都不一致！

jiminyanyan

lsc900707 发表于 2016-7-27 13:47
谢谢！看来我刚学习这个课题就挑了个“刺”！

小公司用不到这个，一年也招不了几个人，不动脑手工最好。

lsc900707

Sub word文档转excel汇总()
     On Error Resume Next
     [A2:AI250].ClearContents
     Application.ScreenUpdating = False
     Dim cPath$, cFile$, str$, i%, arr(1 To 500, 1 To 35)
     Dim wordD As Word.Document
     Dim Wordapp As Object
     Set Wordapp = CreateObject("Word.Application")
     cPath = ThisWorkbook.Path & "\"
     cFile = Dir(cPath & "*.doc?")
     Do While cFile <> ""
         Set wordD = Wordapp.Documents.Open(cPath & cFile)
         For i = 1 To wordD.Tables.Count
             With wordD.Tables(i)
                 arr(i, 1) = i
                 arr(i, 2) = Replace(.Cell(2, 2).Range.Text, Chr(7), "")
                 arr(i, 3) = Replace(.Cell(2, 4).Range.Text, Chr(7), "")
                 arr(i, 4) = Replace(.Cell(2, 6).Range.Text, Chr(7), "")
                 arr(i, 5) = Replace(.Cell(3, 2).Range.Text, Chr(7), "")
                 arr(i, 6) = Replace(.Cell(3, 4).Range.Text, Chr(7), "")
                 arr(i, 7) = Replace(.Cell(3, 6).Range.Text, Chr(7), "")
                 arr(i, 8) = Replace(.Cell(4, 2).Range.Text, Chr(7), "")
                 arr(i, 9) = Replace(.Cell(4, 4).Range.Text, Chr(7), "")
                 arr(i, 10) = Replace(.Cell(5, 2).Range.Text, Chr(7), "")
                 arr(i, 11) = Replace(.Cell(5, 4).Range.Text, Chr(7), "")
                 arr(i, 12) = Replace(.Cell(6, 3).Range.Text, Chr(7), "")
                 arr(i, 13) = Replace(.Cell(6, 5).Range.Text, Chr(7), "")
                 arr(i, 14) = Replace(.Cell(7, 3).Range.Text, Chr(7), "")
                 arr(i, 15) = Replace(.Cell(7, 5).Range.Text, Chr(7), "")
                 arr(i, 16) = Replace(.Cell(8, 2).Range.Text, Chr(7), "")
                 arr(i, 17) = Replace(.Cell(8, 4).Range.Text, Chr(7), "")
                 arr(i, 18) = Replace(.Cell(9, 2).Range.Text, Chr(7), "")
                 arr(i, 19) = Replace(.Cell(9, 4).Range.Text, Chr(7), "")
                 arr(i, 20) = Replace(.Cell(9, 6).Range.Text, Chr(7), "")
                 arr(i, 21) = Replace(.Cell(10, 2).Range.Text, Chr(7), "")
                 arr(i, 22) = Replace(.Cell(13, 2).Range.Text, Chr(7), "")
                 arr(i, 23) = Replace(.Cell(13, 3).Range.Text, Chr(7), "")
                 arr(i, 24) = Replace(.Cell(14, 2).Range.Text, Chr(7), "")
                 arr(i, 25) = Replace(.Cell(14, 3).Range.Text, Chr(7), "")
                 arr(i, 26) = Replace(.Cell(14, 4).Range.Text, Chr(7), "")
                 arr(i, 27) = Replace(.Cell(15, 2).Range.Text, Chr(7), "")
                 arr(i, 28) = Replace(.Cell(15, 3).Range.Text, Chr(7), "")
                 arr(i, 29) = Replace(.Cell(15, 4).Range.Text, Chr(7), "")
                 arr(i, 30) = Replace(.Cell(16, 2).Range.Text, Chr(7), "")
                 arr(i, 31) = Replace(.Cell(16, 3).Range.Text, Chr(7), "")
                 arr(i, 32) = Replace(.Cell(16, 4).Range.Text, Chr(7), "")
                 arr(i, 33) = Replace(.Cell(19, 1).Range.Text, Chr(7), "") & Replace(.Cell(19, 2).Range.Text, Chr(7), "") _
                   & Replace(.Cell(19, 3).Range.Text, Chr(7), "") & Replace(.Cell(19, 4).Range.Text, Chr(7), "") & Chr(13) _
                   & Replace(.Cell(20, 1).Range.Text, Chr(7), "") & Replace(.Cell(20, 2).Range.Text, Chr(7), "") _
                   & Replace(.Cell(20, 3).Range.Text, Chr(7), "") & Replace(.Cell(20, 4).Range.Text, Chr(7), "")
                 arr(i, 34) = Replace(.Cell(23, 1).Range.Text, Chr(7), "") & Replace(.Cell(23, 2).Range.Text, Chr(7), "") _
                   & Replace(.Cell(23, 3).Range.Text, Chr(7), "") & Replace(.Cell(23, 4).Range.Text, Chr(7), "") _
                   & Replace(.Cell(23, 5).Range.Text, Chr(7), "") & Replace(.Cell(23, 6).Range.Text, Chr(7), "") & Chr(13) _
                   & Replace(.Cell(24, 1).Range.Text, Chr(7), "") & Replace(.Cell(24, 2).Range.Text, Chr(7), "") _
                   & Replace(.Cell(24, 3).Range.Text, Chr(7), "") & Replace(.Cell(24, 4).Range.Text, Chr(7), "") _
                   & Replace(.Cell(24, 5).Range.Text, Chr(7), "") & Replace(.Cell(24, 6).Range.Text, Chr(7), "")
                 arr(i, 35) = Replace(.Cell(29, 1).Range.Text, Chr(7), "")
           
         End With
         Next
         wordD.Close
         cFile = Dir
     Loop
     Set wordD = Nothing
     Wordapp.Quit
     Sheet1.Range("A2").Resize(i, 35) = arr
     Application.ScreenUpdating = True
End Sub

代码这么长，有没有进一步优化的可能？

lsc900707

hhjjpp 发表于 2016-7-27 13:48
居然每个word表的行数都不一致！

谢谢大神出手相救！

dyzx

hhjjpp 发表于 2016-7-27 13:48
居然每个word表的行数都不一致！

hhjjpp老师：如果要将多个个人word信息表汇总到EXCEL表上，应该怎样修改代码，多谢指教。

chxw68

dyzx 发表于 2017-1-6 16:49
hhjjpp老师：如果要将多个个人word信息表汇总到EXCEL表上，应该怎样修改代码，多谢指教。

有问题自己开新贴，这样容易得到解决，寄生在别人贴子后面不好。

小花鹿

dyzx 发表于 2017-1-6 16:49
hhjjpp老师：如果要将多个个人word信息表汇总到EXCEL表上，应该怎样修改代码，多谢指教。

比葫芦画瓢就行了，很简单的

dyzx

小花鹿 发表于 2017-1-6 20:21
比葫芦画瓢就行了，很简单的

小花鹿老师：请指教，应该怎样修改代码？

makelot

为什么我一运行就出错？程序定位到 Dim wordD As word.Document 并提示：编译错误:用户定义类型未定义

lsc900707

makelot 发表于 2017-12-23 07:16
为什么我一运行就出错？程序定位到 Dim wordD As word.Document 并提示：编译错误:用户定义类型未定义

把出错的附件上传看看。