Excel提取Word表格内容。小白练手

ht1480

2. <div class="blockcode"><blockquote>'wdCell  12  单元格。
   
3. 'wdCharacter 1   字符。
   
4. 'wdCharacterFormatting   13  字符格式。
   
5. 'wdColumn    9   列。
   
6. 'wdItem  16  所选项。
   
7. 'wdLine  5   一个线段。
   
8. 'wdParagraph 4   段落。
   
9. 'wdParagraphFormatting   14  段落格式。
   
10. 'wdRow   10  行。
    
11. 'wdScreen    7   屏幕尺寸。
    
12. 'wdSection   8   一节。
    
13. 'wdSentence  3   句子。
    
14. 'wdStory 6   部分。
    
15. 'wdTable 15  一个表格。
    
16. 'wdWindow    11  窗口。
    
17. 'wdWord  2   字。
    
18. 'Expand 扩展
    
19. Sub 提取报告工作量稳定版()
    
20. Dim a, myrang
    
21. '搜索工作量表格关键字
    
22. str1 = "建筑物数量"
    
23. Set wdapp = CreateObject("word.application")
    
24. 'Word窗口显示开
    
25. wdapp.Visible = True
    
26. '选择文件夹
    
27. With Application.FileDialog(msoFileDialogFolderPicker)
    
28.         If .Show Then mypath = .SelectedItems(1) Else Exit Sub '打开目标文件夹
    
29. End With
    
30. '文件地址加“\”
    
31.     mypath = mypath & ""
    
32. '从第几行开始写入
    
33.     r = 2
    
34. 'Dir文档名称
    
35.     myfile = Dir(mypath)
    
36. '检查后缀打开文档
    
37. Do While myfile <> ""
    
38.   If Right(UCase(myfile), 4) = ".DOC" Or Right(UCase(myfile), 4) = "DOCX" Then '检查扩展名是否为Word文件
    
39.   Set wddoc = wdapp.Documents.Open(mypath & myfile) '打开文件
    
40. '写入文档名称
    
41. Cells(r, 1) = myfile
    
42. '激活文档
    
43. Set myrange = wdapp.ActiveDocument.Content
    
44. '查找str1
    
45. With myrange.Find
    
46. .Text = str1
    
47. .Forward = True
    
48. .Execute
    
49. If .Found = True Then
    
50. myrange.Select
    
51. 'wdapp.Selection.Move unit:=10, Count:=1
    
52. 'wdapp.Selection.Expand unit:=10
    
53. 'MsgBox (wdapp.Selection.Text)
    
54. 'MsgBox (wdapp.Selection.tables(1).Columns.Count)
    
55. For i = 1 To wdapp.Selection.tables(1).Columns.Count
    
56. Cells(r, i + 1).Value = wdapp.Selection.tables(1).Cell(2, i).Range.Text 'Word表格的内容通过该方法获取
    
57. Cells(r, i + 1).Value = Left(Cells(r, i + 1).Value, Len(Cells(r, i + 1).Value) - 1) '去除获取内容末尾的黑点(左长度减1来实现)
    
58. Next i
    
59. Cells(r, i + 1).Value = wdapp.ActiveDocument.Paragraphs(1).Range.Text
    
60. Cells(r, i + 1).Value = Left(Cells(r, i + 1).Value, Len(Cells(r, i + 1).Value) - 1)
    
61. 'Cells(CellsR, CellsC).Value = wdapp.Selection.tables.Count.Cell(1, 1).Range.Text 'Word表格的内容通过该方法获取
    
62. 'Cells(CellsR, CellsC).Value = Left(Cells(CellsR, CellsC).Value, Len(Cells(CellsR, CellsC).Value) - 1) '去除获取内容末尾的黑点
    
63. 'Cells(r, 2).Value = wdapp.Selection.Text
    
64. 'Cells(r, 3) = Selection.Text
    
65. 'For Each i In ActiveDocument.Paragraphs
    
66. Else
    
67. Cells(r, 2) = "报告内没有此字符"
    
68. End If
    
69. End With
    
70. r = r + 1
    
71. wddoc.Close
    
72. End If
    
73. myfile = Dir()
    
74. Loop
    
75. wdapp.Quit
    
76. MsgBox ("提取出的数据不能进行统计计算" & Chr(10) & "如需统计和计算请另行处理" & Chr(10) & "（可以粘贴到Word再粘贴回Excel）")
    
77. End Sub
    

<div class="blockcode"><blockquote>'wdCell  12  单元格。<br /> 'wdCharacter 1   字符。<br /> 'wdCharacterFormatting   13  字符格式。<br /> 'wdColumn    9   列。<br /> 'wdItem  16  所选项。<br /> 'wdLine  5   一个线段。<br /> 'wdParagraph 4   段落。<br /> 'wdParagraphFormatting   14  段落格式。<br /> 'wdRow   10  行。<br /> 'wdScreen    7   屏幕尺寸。<br /> 'wdSection   8   一节。<br /> 'wdSentence  3   句子。<br /> 'wdStory 6   部分。<br /> 'wdTable 15  一个表格。<br /> 'wdWindow    11  窗口。<br /> 'wdWord  2   字。<br /> 'Expand 扩展<br /> Sub 提取报告工作量稳定版()<br /> Dim a, myrang<br /> '搜索工作量表格关键字<br /> str1 = "建筑物数量"<br /> Set wdapp = CreateObject("word.application")<br /> 'Word窗口显示开<br /> wdapp.Visible = True<br /> '选择文件夹<br /> With Application.FileDialog(msoFileDialogFolderPicker)<br />         If .Show Then mypath = .SelectedItems(1) Else Exit Sub '打开目标文件夹<br /> End With<br /> '文件地址加“\”<br />     mypath = mypath & ""<br /> '从第几行开始写入<br />     r = 2<br /> 'Dir文档名称<br />     myfile = Dir(mypath)<br /> '检查后缀打开文档<br /> Do While myfile <> ""<br />   If Right(UCase(myfile), 4) = ".DOC" Or Right(UCase(myfile), 4) = "DOCX" Then '检查扩展名是否为Word文件<br />   Set wddoc = wdapp.Documents.Open(mypath & myfile) '打开文件<br /> '写入文档名称<br /> Cells(r, 1) = myfile<br /> '激活文档<br /> Set myrange = wdapp.ActiveDocument.Content<br /> '查找str1<br /> With myrange.Find<br /> .Text = str1<br /> .Forward = True<br /> .Execute<br /> If .Found = True Then<br /> myrange.Select<br /> 'wdapp.Selection.Move unit:=10, Count:=1<br /> 'wdapp.Selection.Expand unit:=10<br /> 'MsgBox (wdapp.Selection.Text)<br /> 'MsgBox (wdapp.Selection.tables(1).Columns.Count)<br /> For i = 1 To wdapp.Selection.tables(1).Columns.Count<br /> Cells(r, i + 1).Value = wdapp.Selection.tables(1).Cell(2, i).Range.Text 'Word表格的内容通过该方法获取<br /> Cells(r, i + 1).Value = Left(Cells(r, i + 1).Value, Len(Cells(r, i + 1).Value) - 1) '去除获取内容末尾的黑点(左长度减1来实现)<br /> Next i<br /> Cells(r, i + 1).Value = wdapp.ActiveDocument.Paragraphs(1).Range.Text<br /> Cells(r, i + 1).Value = Left(Cells(r, i + 1).Value, Len(Cells(r, i + 1).Value) - 1)<br /> 'Cells(CellsR, CellsC).Value = wdapp.Selection.tables.Count.Cell(1, 1).Range.Text 'Word表格的内容通过该方法获取<br /> 'Cells(CellsR, CellsC).Value = Left(Cells(CellsR, CellsC).Value, Len(Cells(CellsR, CellsC).Value) - 1) '去除获取内容末尾的黑点<br /> 'Cells(r, 2).Value = wdapp.Selection.Text<br /> 'Cells(r, 3) = Selection.Text<br /> 'For Each i In ActiveDocument.Paragraphs<br /> Else<br /> Cells(r, 2) = "报告内没有此字符"<br /> End If<br /> End With<br /> r = r + 1<br /> wddoc.Close<br /> End If<br /> myfile = Dir()<br /> Loop<br /> wdapp.Quit<br /> MsgBox ("提取出的数据不能进行统计计算" & Chr(10) & "如需统计和计算请另行处理" & Chr(10) & "（可以粘贴到Word再粘贴回Excel）")<br /> End Sub<br />

本小白练手的习题，没看过vb.net，只能用VB宏运行速度慢，如有大神路过请指教优化。

664571221

高手可以加我qq吗3298554767

ht1480

我也是小白，只是在论坛学了点皮毛中的皮毛，提高了自己一点点的工作效率！

sunny_8848

谢谢分享，下载尝试下