目录
一、效果图
标题估计没说明白，上图
1、替换前
2、替换后
如下图目标达成
二、敲代码
1、开发者工具→vba编辑器，点击插入模块
2、键入以下代码
Sub ReplaceTenConsecutiveCells()
Dim tbl As Table, targetCells As Range
Dim oldGroups() As Variant, newGroups() As Variant
Dim 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 = False
For Each tbl In ActiveDocument.Tables
For i = 1 To tbl.Rows.Count
' 动态计算可用列范围
For j = 1 To tbl.Columns.Count - 9 ' 确保有连续10列
' 提取连续10单元格内容（清理结尾符）
Dim currentGroup(9) As String
For k = 0 To 9
On Error Resume Next ' 跳过合并单元格错误
currentGroup(k) = Replace(tbl.cell(i, j + k).Range.Text, Chr(13) & Chr(7), "")
On Error GoTo 0
Next k
' 遍历所有预设规则进行匹配
For k = 0 To UBound(oldGroups)
Dim isMatch As Boolean
isMatch = True
For m = 0 To 9
' 空字符串表示跳过该位置匹配
If oldGroups(k)(m) <> "" And currentGroup(m) <> oldGroups(k)(m) Then
isMatch = False
Exit For
End If
Next m
' 执行替换并标记
If isMatch Then
For m = 0 To 9
On 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 0
Next m
Exit For ' 匹配成功即跳出循环
End If
Next k
Next j
Next i
Next tbl
Application.ScreenUpdating = True
MsgBox "已处理 " & UBound(oldGroups) + 1 & " 组规则，替换完成！"
End Sub一些说明
3、代码编辑完成后，开发者工具→运行宏，选择对应名称，运行
