excel提取word中的信息

m364816836

需要在excel中提取word表格中的某些信息，大概内容如图所示
这是excel中需要提取的
这是要被提取的word表格

其中word表格中的人数可能不同，有6-10人左右，但是word表格的大体数据都是一样，有没有老师帮编写一个VBA宏提取，word表格有几百页。。。

cwpccna

1. Sub test1()
   
2. 
   
3. iweizhi = 14
   
4. 
   
5. 
   
6. '生成合同文件
   
7. Dim yangbenpath As String
   
8. yangbenpath = Application.ActiveWorkbook.Path & Sheets("明细").Cells(iweizhi, 23).Value '获取修改文件《测试.doc》的位置
   
9. 
   
10. Dim deskpath As String
    
11. Dim weizhi As Variant
    
12. 
    
13. Dim WdApp, Wd
    
14. Application.ScreenUpdating = False
    
15. Set WdApp = CreateObject("word.application")
    
16. Set Wd = WdApp.Documents.Open(yangbenpath)  '打开文件《测试.doc》
    
17. WdApp.Visible = True
    
18.   WdApp.Selection.Find.ClearFormatting
    
19. 
    
20.        'weizhi = Split(Sheets("明细").Cells(iweizhi, 24).Value, ",") '以,号分隔的数据赋值
    
21.        Dim i As Long
    
22.        'For i = 0 To UBound(weizhi)
    
23.        For i = 23 To 32 Step 1
    
24. 
    
25. 
    
26.         '替换cells(23,23)到cells（32，24）里面对应的内容
    
27.         WdApp.Selection.Find.Replacement.ClearFormatting
    
28.         With WdApp.Selection.Find
    
29.         .ClearFormatting
    
30.         .Text = Sheets("明细").Cells(i, 23).Value
    
31.         .Replacement.ClearFormatting
    
32.         .Replacement.Text = Sheets("明细").Cells(i, 24).Value
    
33.         .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
    
34.         End With
    
35. 
    
36. 
    
37.        Next i
    
38. 
    
39. deskpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & ""    '获取桌面位置路径
    
40. Wd.SaveAs deskpath & Sheets("明细").Cells(3, 24).Value & ".doc" '另存到桌面，文件名称为合同名
    
41. 
    
42. WdApp.Visible = True
    
43. Set Wd = Nothing
    
44. Set WdApp = Nothing
    
45. 
    
46. Application.ScreenUpdating = True
    
47. 
    
48. 
    
49. 
    
50. 
    
51. End Sub

复制代码

cwpccna

cwpccna 发表于 2018-8-9 11:33

直接拷贝到项目中,运行,完美解决