快速汇总Word表格
示例需求:Word文档中的有多个表格,其中最后一个表格为汇总表格
,其他的为数据表格
,如下图中左侧所示。
现在需要根据Category1
和Category2
,在数据表格中查找,如果找到匹配行,那么
- 为数据表中改行创建书签Bookmark
- 在
汇总表格
中记录匹配行位置,例如表格Table_1中第3行
- 为上述文字添加超链接指向书签
完成后的效果如下图中右侧所示。
示例代码如下。
Sub LinkMatches()
Dim i As Long, j As Long, r As Long
Dim oDoc As Document, tabIndex As String
Dim sumTab As Table, oTab As Table
Dim sKey1 As String, sKey2 As String, bFirst As Boolean
Dim cellRange As Range, paraRng As Range
Const S_ROW = 3
Set oDoc = ThisDocument
Set sumTab = oDoc.Tables(oDoc.Tables.Count)
For r = 3 To sumTab.Rows.Count
sKey1 = GetTxt(sumTab.Cell(i, 2).Range.Text) & "|" & _
GetTxt(sumTab.Cell(i, 3).Range.Text)
Set cellRange = sumTab.Cell(i, 5).Range
cellRange.Text = ""
bFirst = True
For i = 1 To oDoc.Tables.Count - 1
Set oTab = oDoc.Tables(i)
tabIndex = "Table_" & i
For j = 3 To oTab.Rows.Count
sKey2 = GetTxt(oTab.Cell(j, 2).Range.Text) & "|" & _
GetTxt(oTab.Cell(j, 3).Range.Text)
If sKey1 = sKey2 Then
oTab.Rows(j).Range.Bookmarks.Add tabIndex & "Row" & j
If Not bFirst Then
cellRange.InsertAfter vbCr
End If
cellRange.InsertAfter "表格" & tabIndex & "中第" & j & "行"
Set paraRng = cellRange.Paragraphs.Last.Range
paraRng.MoveEnd wdCharacter, -1
cellRange.Hyperlinks.Add Anchor:=paraRng, _
Address:="", SubAddress:=tabIndex & "Row" & j, _
TextToDisplay:="表格" & tabIndex & "中第" & j & "行"
bFirst = False
End If
Next
Next
Next
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 String
sTxt = 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,不可见字符)。