如何将相同的word应聘表格中的信息汇总至excel中，帮帮忙

zkkillero

将相同的word应聘表格中的信息汇总至excel中，word及excel模版在附件中。

zkkillero

有老师在吗，用的2016，万分感谢，

老骥705664849

自己搜搜看吧，这种贴子论坛很多的

zkkillero

老骥705664849 发表于 2020-6-29 17:01
自己搜搜看吧，这种贴子论坛很多的

自己也在搜索，奈何小白一枚，有点看不懂啊老哥

chxw68

1. Sub test()
   
2.   Dim r%, i%, m%
   
3.   Dim brr(1 To 1000, 1 To 22)
   
4.   Dim mypath$, myname$
   
5.   Dim wordapp As Object
   
6.   Dim mypdoc As Object
   
7.   Dim mytables As Object
   
8.   Set wordapp = CreateObject("word.application")
   
9.   mypath = ThisWorkbook.Path & ""
   
10.   myname = Dir(mypath & "*.docx")
    
11.   Do While myname <> ""
    
12.     Set mydoc = wordapp.documents.Open(Filename:=mypath & myname)
    
13.     With mydoc
    
14.       With .tables(1)
    
15.         m = m + 1
    
16.         brr(m, 1) = m
    
17.         brr(m, 2) = Replace(.cell(1, 2).Range.Text, Chr(13) & Chr(7), "")
    
18.         brr(m, 3) = Replace(.cell(2, 2).Range.Text, Chr(13) & Chr(7), "")
    
19.         brr(m, 4) = Replace(.cell(2, 4).Range.Text, Chr(13) & Chr(7), "")
    
20.         brr(m, 5) = Replace(.cell(3, 4).Range.Text, Chr(13) & Chr(7), "")
    
21.         brr(m, 6) = Replace(.cell(4, 2).Range.Text, Chr(13) & Chr(7), "")
    
22.         brr(m, 7) = Replace(.cell(2, 6).Range.Text, Chr(13) & Chr(7), "")
    
23.         brr(m, 8) = ""
    
24.         brr(m, 9) = Replace(.cell(6, 2).Range.Text, Chr(13) & Chr(7), "")
    
25.         brr(m, 10) = Replace(.cell(3, 6).Range.Text, Chr(13) & Chr(7), "")
    
26.         brr(m, 11) = Replace(.cell(5, 6).Range.Text, Chr(13) & Chr(7), "")
    
27.         brr(m, 12) = Replace(.cell(4, 6).Range.Text, Chr(13) & Chr(7), "")
    
28.         brr(m, 13) = Replace(.cell(7, 2).Range.Text, Chr(13) & Chr(7), "")
    
29.         brr(m, 14) = ""
    
30.         brr(m, 15) = ""
    
31.         brr(m, 16) = ""
    
32.         brr(m, 17) = ""
    
33.         brr(m, 18) = ""
    
34.         brr(m, 19) = Replace(.cell(8, 4).Range.Text, Chr(13) & Chr(7), "")
    
35.         brr(m, 20) = Replace(.cell(6, 2).Range.Text, Chr(13) & Chr(7), "")
    
36.       End With
    
37.     End With
    
38.     mydoc.Close False
    
39.     myname = Dir
    
40.   Loop
    
41.   wordapp.Quit
    
42.   With Worksheets("汇总")
    
43.     .UsedRange.Offset(2, 0).ClearContents
    
44.     .Range("a3").Resize(m, UBound(brr, 2)) = brr
    
45.   End With
    
46. End Sub
    

复制代码

chxw68

详见附件。

chxw68

楼主表格空空如也，想测试都没办法，代码框架搭起来了，有些字段内容不对的楼主自己修改吧。

zkkillero

chxw68 发表于 2020-6-29 18:37
楼主表格空空如也，想测试都没办法，代码框架搭起来了，有些字段内容不对的楼主自己修改吧。

厉害老哥，有些地方我在琢磨一下，再次感谢