关于在Excel中使用vba读取Word文档内的表格的问题,直接赋值给二维数组咋写？

Lackfeeling

最近手里有上万份格式一样的Word文档，这些文档都需要审查，看看是不是填的规范，并且需要筛查一些逻辑关系
靠人力一个一个点开看，这工作量太大。所以自己写了个word2Excel的函数，但是写完后发现效率不是很高

有没有老师能指点下
我所疑惑的是，document.tables集合里的每一个表内的各个单元格的内容，能不能直接赋值给二维数组？最近百度了很久也没找到相关的解决办法

目前的代码如下，实在不知道二维数组咋优化了：

1. Public Function 分析word所有表格(FullNamePath As String) As Variant '函数返回值为 二维数组
   
2.   Rem 注意保持2维数组各行的列数一致，不然Sheet5.Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr 赋值时，数组边界会报错
   
3.     Dim WdApp As Word.Application, Doc As Document   '前期绑定，有输入提示，兼容性差，容易报错
   
4.     Set WdApp = New Word.Application                 '前期绑定，有输入提示，兼容性差，容易报错
   
5.     'Dim WdApp As Object, Doc As Object              '后期绑定，无输入提示，兼容性好
   
6.     'Set WdApp = CreateObject("Word.Application")    '后期绑定，无输入提示，兼容性好
   
7.     With WdApp
   
8.         .Visible = False                     '不可见
   
9.         .ScreenUpdating = False              '不屏幕刷新
   
10.         .DisplayAlerts = wdAlertsNone        '不提示任何弹框警告提示？
    
11.     End With
    
12.     Set Doc = WdApp.Documents.Open(FullNamePath, ReadOnly:=True)
    
13.     Dim tbs As Tables, tb As Table, vCell As Cell, m As Long, i As Long, n As Long, txt As Variant, arr() As Variant, maxcol As Long
    
14.     Set tbs = Doc.Tables: m = tbs.Count
    
15.     Debug.Print "该文档有：", m, "张表格"
    
16.     If m = 0 Then
    
17.         分析word所有表格 = Empty: Exit Function
    
18.     Else
    
19.         'Debug.Print "表1的第一个单元格测试", Doc.Tables.Item(1).Cell(1, 1).Range.Text       '该单元格：事先已知 位于 第几行 第几列
    
20.         'Debug.Print "表1的第一个单元格测试", Doc.Tables.Item(1).Range.Cells(1).Range.Text   '该单元格：事先未知 位于 第几行 第几列  【优点是有索引号，便于for循环】
    
21.         
    
22.         'Debug.Print "表1的第一个单元格测试", Doc.Tables(1).Cell(1, 1).Range.Text       '该单元格：事先已知 位于 第几行 第几列
    
23.         'Debug.Print "表1的第一个单元格测试", Doc.Tables(1).Range.Cells(1).Range.Text   '该单元格：事先未知 位于 第几行 第几列  【优点是有索引号，便于for循环】
    
24.         
    
25.         
    
26.         i = 1 '首张表的索引号
    
27.         For Each tb In tbs
    
28.             n = tb.Range.Cells.Count
    
29.             Debug.Print "开始分析 第", i, "张表格,共", n, "个单元格"
    
30.             If n >= maxcol Then maxcol = n '当前表的单元格个数，大于上个表的个数时，对比赋值；始终保持二维动态数组的列为最大值
    
31.             Debug.Print "当前返回数组边界：(" & m & "," & maxcol & ")"
    
32.             ReDim Preserve arr(1 To m, 1 To maxcol) '保留原数据，重新声明该动态数组的上、下届;1 to m 为表的索引号，1 to n 为单元格的索引号
    
33.             n = 1 '首个单元格索引号
    
34.             For Each vCell In tb.Range.Cells
    
35.                 arr(i, n) = RepSymbols(vCell.Range.Text) '去除不可见的特殊符号 有残留[\u0001\u0007]
    
36.                 'Debug.Print "arr(" & i & " , " & n & ")", arr(i, n)
    
37.                 'Debug.Print Doc.Tables.Item(i).Cell(vCell.RowIndex, vCell.ColumnIndex).Range.Text, "Doc.Tables.Item(" & i & ").Cell(" & vCell.RowIndex & "," & vCell.ColumnIndex & ").Range.Text="
    
38.                 'Debug.Print Doc.Tables.Item(i).Range.Cells(n).Range.Text, "Doc.Tables.Item(" & i&; ").Range.Cells(" & n&; ").Range.Text="
    
39.                 n = n + 1 '第N个单元格
    
40.             Next
    
41.             i = i + 1 '表的索引
    
42.         Next
    
43.     End If
    
44.     分析word所有表格 = arr
    
45.     Doc.Close: WdApp.Quit: Set Doc = Nothing: Set WdApp = Nothing
    
46. End Function

复制代码