利用vba替换word中多个表格，相邻单元格的文字

一、效果图

标题估计没说明白，上图

1、替换前

2、替换后

如下图目标达成

二、敲代码

1、开发者工具→vba编辑器，点击插入模块

2、键入以下代码

Sub ReplaceTenConsecutiveCells()Dim tbl As Table, targetCells As RangeDim oldGroups() As Variant, newGroups() As VariantDim i As Long, j As Long, k As Long, m As Long' ====== 配置区 ======' 定义旧值组合 vs 新值组合（必须一一对应）oldGroups = Array(Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10"), Array("B1", "B2", "B3", "", "", "", "", "", "", ""))newGroups = Array( _Array("New1", "New2", "New3", "New4", "New5", "New6", "New7", "New8", "New9", "New10"), _Array("替换1", "替换2", "替换3", "", "", "", "", "", "", "") _)'Const HIGHLIGHT_COLOR As Long = RGB(0, 176, 80) ' 标记颜色（绿色）' ====== 配置结束 ======Application.ScreenUpdating = FalseFor Each tbl In ActiveDocument.TablesFor i = 1 To tbl.Rows.Count' 动态计算可用列范围For j = 1 To tbl.Columns.Count - 9 ' 确保有连续10列' 提取连续10单元格内容（清理结尾符）Dim currentGroup(9) As StringFor k = 0 To 9On Error Resume Next ' 跳过合并单元格错误currentGroup(k) = Replace(tbl.cell(i, j + k).Range.Text, Chr(13) & Chr(7), "")On Error GoTo 0Next k' 遍历所有预设规则进行匹配For k = 0 To UBound(oldGroups)Dim isMatch As BooleanisMatch = TrueFor m = 0 To 9' 空字符串表示跳过该位置匹配If oldGroups(k)(m) <> "" And currentGroup(m) <> oldGroups(k)(m) ThenisMatch = FalseExit ForEnd IfNext m' 执行替换并标记If isMatch ThenFor m = 0 To 9On Error Resume Next ' 跳过合并单元格写入tbl.cell(i, j + m).Range.Text = newGroups(k)(m)tbl.cell(i, j + m).Shading.BackgroundPatternColor = RGB(0, 176, 80)On Error GoTo 0Next mExit For ' 匹配成功即跳出循环End IfNext kNext jNext iNext tblApplication.ScreenUpdating = TrueMsgBox "已处理 " & UBound(oldGroups) + 1 & " 组规则，替换完成！"
End Sub

一些说明

3、代码编辑完成后，开发者工具→运行宏，选择对应名称，运行