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

目录

一、效果图

标题估计没说明白,上图

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、代码编辑完成后,开发者工具→运行宏,选择对应名称,运行

相关推荐
CNRio10 小时前
将word和excel快速转换为markdown格式
python·word·excel
玩泥巴的2 天前
.NET驾驭Word之力:基于规则自动生成及排版Word文档
c#·word·.net·com互操作
道之极万物灭2 天前
Python操作word实战
开发语言·python·word
跳动的喵尾巴4 天前
Endnote | word中加载项消失不见,如何处理?
word
夜白宋4 天前
【word多文档docx合并】
java·word
Uluoyu6 天前
word、pdf文档内容提取工具类
java·pdf·word
sanshizhang6 天前
word文档转pdf开源免费,可自定义水印
pdf·开源·word
lijingguang6 天前
excel和word文件默认用office打开而不是用wps
word·excel·wps
Uluoyu7 天前
支持Word (doc/docx) 和 PDF 转成一张垂直拼接的长PNG图片工具类
java·pdf·word
VBAMatrix7 天前
报告工具更新!Word附注一键期末转期初
word·办公自动化·审计报告·审计·会计师事务所·报告工具·word附注