如何用VBA从固定格式word里提取数据填充到excel里

Leo121

我有一个固定格式的word文档想提数据出来，放到excel里，用vba怎么实现，求大神一段代码，非常感谢
提取出来的格式类似于下边的

年份	序号	项目	完成时间
2008	1	水利	2008年11月
2008	2	给排水	2008年12月

其余年份都是重复的，请看附件word文档

duquancai

1. Sub WordVBA()
   
2.     Dim mt, oRang As Range, rng As Range, S$
   
3.     Dim arr(1 To 1000, 1 To 4)
   
4.     Set rng = ActiveDocument.Content
   
5.     Application.ScreenUpdating = False
   
6.     ActiveDocument.Content.ListFormat.ConvertNumbersToText
   
7.     With CreateObject("vbscript.regexp")
   
8.         .Pattern = "(\d{4})年工程((?:(?!\d{4}年工程)[\s\S])*)"
   
9.         .Global = True: .MultiLine = True
   
10.         For Each mt In .Execute(rng)
    
11.             .Pattern = "^(\d+)\..*?^项目：\s*([^\r]+)\r完成时间：\s*([^\r]+)"
    
12.             S = mt.submatches(1): t = mt.submatches(0)
    
13.             For Each mh In .Execute(S)
    
14.                 n = n + 1
    
15.                 arr(n, 1) = t
    
16.                 arr(n, 2) = mh.submatches(0)
    
17.                 arr(n, 3) = mh.submatches(1)
    
18.                 arr(n, 4) = "'" & mh.submatches(2)
    
19.             Next
    
20.         Next
    
21.     End With
    
22.     With CreateObject("Excel.Application")
    
23.         If Tasks.Exists("Microsoft Excel") = True Then Tasks("Microsoft Excel").Close
    
24.         Set myBook = .Workbooks.Add: .Visible = True
    
25.         Set mysheet = myBook.Worksheets("sheet1"): mysheet.Activate
    
26.         mysheet.Range("a1:d1") = Array("年份", "序号", "项目", "完成时间")
    
27.         mysheet.Range("a2").Resize(n, 4) = arr
    
28.     End With
    
29.     Set myBook = Nothing: Set mysheet = Nothing
    
30.     Application.ScreenUpdating = True
    
31. End Sub

复制代码

duquancai

详见附件，打开Word文件，点击按钮》》》》》》》》》》》》》》》》

Leo121

非常感谢大神的帮助

Leo121

试了一下非常棒，感激不尽，大爱啊

jiminyanyan

duquancai 发表于 2016-10-24 12:26

.Pattern = "(\d{4})年工程((?:(?!\d{4}年工程)[\s\S])*)"
杜老师，这个正则能稍微解读一下么，？：　？！　看的迷糊．．．．

jiminyanyan

jiminyanyan 发表于 2017-4-7 20:30
.Pattern = "(\d{4})年工程((?:(?!\d{4}年工程)[\s\S])*)"
杜老师，这个正则能稍微解读一下么，？：　 ...

有点搞懂了．．．．．