请问如何提取WORD中的指定数字

yanyt

请问如何提取WORD中的指定数字，将它输出到EXCEL表中，见附件，谢谢了！

QQ214189912

1. Sub test()
   
2.     Dim s$, n%, i%, arr, doc As Object, fso As Object, fp As Object, f As Object
   
3.     Dim Regx As Object, mh As Object
   
4.     Set Regx = CreateObject("vbscript.regexp")
   
5.     Regx.Pattern = ".班费用(\d{1,5})万元"
   
6.     Regx.Global = True
   
7.     Set fso = CreateObject("scripting.filesystemobject")
   
8.     Set fp = fso.getfolder(ThisWorkbook.Path)
   
9.     ReDim arr(1 To 3, 1 To 13)
   
10.     For Each f In fp.Files
    
11.         If f Like "*.doc*" Then
    
12.             Set doc = GetObject(f)
    
13.             s = doc.Content
    
14.             Set doc = Nothing
    
15.             Set mh = Regx.Execute(s)
    
16.            If mh.Count <> 0 Then
    
17.                 For i = 0 To mh.Count - 1
    
18.                     arr(1, i + 1) = mh(i).submatches(0)
    
19.                     arr(2, i + 1) = "万元"
    
20.                     arr(3, i + 1) = mh(i)
    
21.                 Next
    
22.             End If
    
23.         End If
    
24.     Next
    
25.     Set Regx = Nothing: Set fp = Nothing
    
26.     Set fso = Nothing
    
27.     Sheets("Sheet1").Range("a7").Resize(UBound(arr, 2), UBound(arr, 1)) = WorksheetFunction.Transpose(arr)
    
28. End Sub

复制代码

yanyt

非常感谢您的回复！辛苦了！不过我可能没有说清楚，数字有可能是小数的，另外，不一定带“费用”两个字，我又重新上传了附件，麻烦您修改一下代码好吗？先谢谢了！

QQ214189912

yanyt 发表于 2017-3-16 20:05
非常感谢您的回复！辛苦了！不过我可能没有说清楚，数字有可能是小数的，另外，不一定带“费用”两个字，我 ...

1. Regx.Pattern = "[\u4e00-\u9fa5]+([\d.]+)(?:万元)"

复制代码

yanyt

QQ214189912 发表于 2017-3-16 20:30

现在可以了，太感谢您了！

cangbei

学习中，厉害