多个word简历合并为excel

zpy2

loveer 发表于 2019-6-5 08:48
报简历变成表格，简建立档案管理系统

档案库，要这样子存Excel 每一行啊？

梧叶沙沙

可以做的，可联系我vx285538335

chxw68

1. Sub test()
   
2.   Dim wordapp As Object
   
3.   Dim mydoc As Object
   
4.   Set wordapp = CreateObject("word.application")
   
5.   Set mydoc = CreateObject("word.document")
   
6.   Dim r%, i%
   
7.   Dim myapth$, myname$
   
8.   Dim brr(1 To 100, 1 To 17)
   
9.   Application.ScreenUpdating = False
   
10.   mypath = ThisWorkbook.Path & ""
    
11.   myname = Dir(mypath & "*.doc")
    
12.   Do While myname <> ""
    
13.     m = m + 1
    
14.     Set mydoc = wordapp.Documents.Open(mypath & myname)
    
15.     With mydoc
    
16.       With .tables(1)
    
17.         brr(m, 1) = Replace(.Cell(1, 2).Range.Text, Chr(13) & Chr(7), "")
    
18.         brr(m, 2) = Replace(.Cell(1, 4).Range.Text, Chr(13) & Chr(7), "")
    
19.         brr(m, 3) = Replace(.Cell(1, 6).Range.Text, Chr(13) & Chr(7), "")
    
20.         brr(m, 4) = Replace(.Cell(2, 2).Range.Text, Chr(13) & Chr(7), "")
    
21.         brr(m, 5) = Replace(.Cell(2, 4).Range.Text, Chr(13) & Chr(7), "")
    
22.         brr(m, 6) = Replace(.Cell(2, 6).Range.Text, Chr(13) & Chr(7), "")
    
23.         brr(m, 7) = Replace(.Cell(3, 2).Range.Text, Chr(13) & Chr(7), "")
    
24.         brr(m, 8) = Replace(.Cell(3, 4).Range.Text, Chr(13) & Chr(7), "")
    
25.         brr(m, 9) = Replace(.Cell(4, 2).Range.Text, Chr(13) & Chr(7), "")
    
26.         brr(m, 10) = Replace(.Cell(4, 4).Range.Text, Chr(13) & Chr(7), "")
    
27.         brr(m, 16) = Replace(.Cell(7, 2).Range.Text, Chr(13) & Chr(7), "")
    
28.         brr(m, 17) = Replace(.Cell(8, 2).Range.Text, Chr(13) & Chr(7), "")
    
29.         ss = Replace(.Cell(5, 2).Range.Text, Chr(13) & Chr(7), "")
    
30.         xm = Split(ss, Chr(13))
    
31.         For k = 0 To Application.Min(3, UBound(xm))
    
32.           brr(m, k + 11) = xm(k)
    
33.         Next
    
34.       End With
    
35.       .Close False
    
36.     End With
    
37.     myname = Dir
    
38.   Loop
    
39.   wordapp.Quit
    
40.   With Worksheets("sheet1")
    
41.     .UsedRange.Offset(2, 0).Clear
    
42.     .Columns(9).NumberFormatLocal = "@"
    
43.     .Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
44.   End With
    
45. End Sub
    
46. 
    

复制代码

chxw68

详见附件。

chxw68

利用数组把代码简化了一下。

1. Sub test()
   
2.   Dim wordapp As Object
   
3.   Dim mydoc As Object
   
4.   Set wordapp = CreateObject("word.application")
   
5.   Set mydoc = CreateObject("word.document")
   
6.   Dim r%, i%
   
7.   Dim myapth$, myname$
   
8.   Dim brr(1 To 100, 1 To 17)
   
9.   vs = [{1,1,2;2,1,4;3,1,6;4,2,2;5,2,4;6,2,6;7,3,2;8,3,4;9,4,2;10,4,4;16,7,2;17,8,2}]
   
10.   Application.ScreenUpdating = False
    
11.   mypath = ThisWorkbook.Path & ""
    
12.   myname = Dir(mypath & "*.doc")
    
13.   Do While myname <> ""
    
14.     m = m + 1
    
15.     Set mydoc = wordapp.Documents.Open(mypath & myname)
    
16.     With mydoc
    
17.       With .tables(1)
    
18.         For k = 1 To UBound(vs)
    
19.           brr(m, vs(k, 1)) = Replace(.Cell(vs(k, 2), vs(k, 3)).Range.Text, Chr(13) & Chr(7), "")
    
20.         Next
    
21.         ss = Replace(.Cell(5, 2).Range.Text, Chr(13) & Chr(7), "")
    
22.         xm = Split(ss, Chr(13))
    
23.         For k = 0 To Application.Min(4, UBound(xm))
    
24.           brr(m, k + 11) = xm(k)
    
25.         Next
    
26.       End With
    
27.       .Close False
    
28.     End With
    
29.     myname = Dir
    
30.   Loop
    
31.   wordapp.Quit
    
32.   With Worksheets("sheet1")
    
33.     .UsedRange.Offset(2, 0).Clear
    
34.     .Columns(9).NumberFormatLocal = "@"
    
35.     .Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
36.   End With
    
37.   Application.ScreenUpdating = True
    
38.   MsgBox "数据提取完毕！"
    
39. End Sub
    
40. 
    

复制代码

chxw68

利用数组把代码简化了一下，并纠正了其中一个小错误。

loveer

chxw68 发表于 2019-8-1 21:46
利用数组把代码简化了一下，并纠正了其中一个小错误。

不好意思 ，以为没人看这个帖子了，回复晚了，非常感谢！

jeckey_an

好东西，收藏

jjmysjg

chxw68 发表于 2019-8-1 21:46
利用数组把代码简化了一下，并纠正了其中一个小错误。

留个记号，谢谢

云海拾贝

好东西，收藏学习