快速汇总Word表格

示例需求：Word文档中的有多个表格，其中最后一个表格为汇总表格，其他的为数据表格，如下图中左侧所示。

现在需要根据Category1和Category2，在数据表格中查找，如果找到匹配行，那么

1. 为数据表中改行创建书签Bookmark
2. 在汇总表格中记录匹配行位置，例如表格Table_1中第3行
3. 为上述文字添加超链接指向书签

完成后的效果如下图中右侧所示。

示例代码如下。

Sub LinkMatches()Dim i As Long, j As Long, r As LongDim oDoc As Document, tabIndex As StringDim sumTab As Table, oTab As TableDim sKey1 As String, sKey2 As String, bFirst As BooleanDim cellRange As Range, paraRng As RangeConst S_ROW = 3Set oDoc = ThisDocumentSet sumTab = oDoc.Tables(oDoc.Tables.Count)For r = 3 To sumTab.Rows.CountsKey1 = GetTxt(sumTab.Cell(i, 2).Range.Text) & "|" & _GetTxt(sumTab.Cell(i, 3).Range.Text)Set cellRange = sumTab.Cell(i, 5).RangecellRange.Text = ""bFirst = TrueFor i = 1 To oDoc.Tables.Count - 1Set oTab = oDoc.Tables(i)tabIndex = "Table_" & iFor j = 3 To oTab.Rows.CountsKey2 = GetTxt(oTab.Cell(j, 2).Range.Text) & "|" & _GetTxt(oTab.Cell(j, 3).Range.Text)If sKey1 = sKey2 ThenoTab.Rows(j).Range.Bookmarks.Add tabIndex & "Row" & jIf Not bFirst ThencellRange.InsertAfter vbCrEnd IfcellRange.InsertAfter "表格" & tabIndex & "中第" & j & "行"Set paraRng = cellRange.Paragraphs.Last.RangeparaRng.MoveEnd wdCharacter, -1cellRange.Hyperlinks.Add Anchor:=paraRng, _Address:="", SubAddress:=tabIndex & "Row" & j, _TextToDisplay:="表格" & tabIndex & "中第" & j & "行"bFirst = FalseEnd IfNextNextNext
End Sub

【代码解析】
第7行代码定义常量，指定数据行从表格第3行开始。
第8行代码获取当前文档对象。
第9行代码获取文档中最后一个表格对象，即汇总表格。
第10行代码在汇总表格中从第3行开始遍历每一行。
第11~12行代码读取第2列和第3列，并组合为关键字。
第13行代码获取第5列单元格。
第14行代码清空第5列单元格。
第15行代码设置首个匹配记录标志位为True。
第16~36行代码循环遍历工作表中的表格（不包含汇总表格）。
第17行代码获取表格对象。
第18行代码为表格标识名称（表格对象的Name属性可能不规范，并且和表格在文档中出现的顺序不同，例如Table1在Table2之后）。
第19~35行代码循环遍历数据表格的每行数据。
第20~21行代码从当前行提取关键字。
第22行代码判断两个关键字是否相同。
第23行代码为当前数据行添加书签。
第24行代码判断是否为首个匹配记录，如果是的话，第25行代码将在汇总单元格中插入回车符。
第27行代码在汇总单元格中追加匹配记录信息。
第28行代码获取汇总单元格中的最后一个段落。
第29行代码将段落结束位置向前移动一个字符，即不包含单元格结束标志。
注意：如果没有第29行代码，并且汇总单元格中包含多个段落时，虽然cellRange为最后一个段落的Range对象，但是第30~32行代码将为第一个段落设置超链接，听起来似乎不可思议，但是多次测试Word 365就是这个效果。
第30~32行代码为汇总单元格最后一个段落条件超链接。
第33行代码将标识变量设置为False。

下面的自定义函数用于清理Word表格单元格内容，去除不可见字符。

Function GetTxt(sTxt As String) As StringsTxt = Replace(sTxt, Chr(7), "")sTxt = Replace(sTxt, vbCr, "")sTxt = Replace(sTxt, vbLf, "")sTxt = Replace(sTxt, Chr(160), "")GetTxt = Trim(sTxt)
End Function

【代码解析】
第2行代码清除Word表格单元格标志。
第3~4行代码清除回车换行符。
第5行代码清除Word的非间断空格（no-break space，不可见字符）。