跳至主要内容

如何从Word文档中的表格删除重复行?

Author: Sun Last Modified: 2025-05-07

在Word文档中,可能会有一些包含重复行的表格,有时您希望删除这些重复行并仅保留首次出现的行。在这种情况下,您可以选择手动逐一删除重复项,也可以选择使用VBA代码来完成操作。

从Word中的表格删除重复行


从Word中的表格删除重复行

1. 将光标放在要删除重复行的表格上,按 Alt + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2. 点击 插入 > 模块 以创建一个新的模块。
Insert > Module options in the VBA window

3. 复制以下代码并将其粘贴到新模块脚本中。

VBA:从Word中的表格删除重复行

Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
    Dim xTable As Table
    Dim xRow As Range
    Dim xStr As String
    Dim xDic As Object
    Dim I, J, KK, xNum As Long
    If ActiveDocument.Tables.Count = 0 Then
        MsgBox "This document does not have table(s).", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set xDic = CreateObject("Scripting.Dictionary")
    If Selection.Information(wdWithInTable) Then
        Set xTable = Selection.Tables(1)
        For I = xTable.Rows.Count To 1 Step -1
            Set xRow = xTable.Rows(I).Range
            xStr = xRow.Text
            xNum = -1
            If xDic.Exists(xStr) Then
'                xTable.Rows(I).Delete
                For J = xTable.Rows.Count To 1 Step -1
                    If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then
                        xNum = xNum + 1
                        xTable.Rows(J).Delete
                    End If
                Next
                I = I - xNum
            Else
                xDic.Add xStr, I
            End If
        Next
    Else
        For I = 1 To ActiveDocument.Tables.Count
            Set xTable = ActiveDocument.Tables(I)
            xNum = -1
            xDic.RemoveAll
            For J = xTable.Rows.Count To 1 Step -1
                Set xRow = xTable.Rows(J).Range
                xStr = xRow.Text
                xNum = -1
                If xDic.Exists(xStr) Then
    '                xTable.Rows(I).Delete
                    For KK = xTable.Rows.Count To 1 Step -1
                        If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then
                            xNum = xNum + 1
                            xTable.Rows(KK).Delete
                        End If
                    Next
                    J = J - xNum
                Else
                    xDic.Add xStr, J
                End If
            Next
        Next
    End If
    Application.ScreenUpdating = True
End Sub

VBA pasted into the Module window

4. 按 F5 键运行代码,然后所有重复行将被删除。
All duplicate rows are removed from the table

注意:上述代码区分大小写,如果要在不区分大小写的情况下删除重复行,可以使用以下代码:

Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
    Dim xTable As Table
    Dim xRow As Range
    Dim xStr As String
    Dim xDic As Object
    Dim I, J, KK, xNum As Long
    If ActiveDocument.Tables.Count = 0 Then
        MsgBox "This document does not have table(s).", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set xDic = CreateObject("Scripting.Dictionary")
    If Selection.Information(wdWithInTable) Then
        Set xTable = Selection.Tables(1)
        For I = xTable.Rows.Count To 1 Step -1
            Set xRow = xTable.Rows(I).Range
            xStr = UCase(xRow.Text)
            xNum = -1
            If xDic.Exists(xStr) Then
'                xTable.Rows(I).Delete
                For J = xTable.Rows.Count To 1 Step -1
                    If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then
                        xNum = xNum + 1
                        xTable.Rows(J).Delete
                    End If
                Next
                I = I - xNum
            Else
                xDic.Add xStr, I
            End If
        Next
    Else
        For I = 1 To ActiveDocument.Tables.Count
            Set xTable = ActiveDocument.Tables(I)
            xNum = -1
            xDic.RemoveAll
            For J = xTable.Rows.Count To 1 Step -1
                Set xRow = xTable.Rows(J).Range
                xStr = UCase(xRow.Text)
                xNum = -1
                If xDic.Exists(xStr) Then
    '                xTable.Rows(I).Delete
                    For KK = xTable.Rows.Count To 1 Step -1
                        If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then
                            xNum = xNum + 1
                            xTable.Rows(KK).Delete
                        End If
                    Next
                    J = J - xNum
                Else
                    xDic.Add xStr, J
                End If
            Next
        Next
    End If
    Application.ScreenUpdating = True
End Sub

如果您想删除文档中所有表格的重复行,请将光标放在表格外文档的任意位置,然后应用上述代码之一。


Office Tab:为 Word、Excel、PowerPoint 等带来选项卡式界面…
Navigate through documents using Office Tab

借助 AI 增强的 Kutools for Word,在更短时间内完成更多工作

Kutools for Word 不仅仅是一套工具——它是一个旨在提升您生产力的智能解决方案。通过人工智能驱动的功能和最核心的特性,Kutools 帮助您在更短的时间内完成更多任务:

  • 即时总结、润色、撰写和翻译内容。
  • 在您写作时,实时校正文本,并提供语法、标点和样式建议。
  • 在保持布局、样式和结构不变的情况下,重新表达和翻译内容。
  • 轻松将您的内容翻译成 40 多种语言,扩大全球影响力。
  • 根据当前文档内容,获得即时帮助和智能见解。
  • 询问如何完成某项任务(例如清除分节符),AI 将为您提供指南或直接为您完成操作。
  • 快速编辑敏感或机密信息,确保完全隐私。
  • 所有工具均可无缝集成到 Word 中,随时可用。
  • 轻松创建、优化、翻译、总结和保护文档。
  • 在实时写作过程中改进语法、清晰度和语气。
  • 重新表达和翻译内容,且不改变布局或格式。
  • 询问如何完成某项任务(例如清除分节符),AI 将为您提供指南或直接为您完成操作。
  • 所有工具均可无缝集成到 Word 中,随时可用。
了解更多关于 Kutools for Word 的信息 立即下载
Kutools for Word features

最佳办公生产力工具

Kutools for Word - 通过超过 100 个卓越功能提升您的 Word 体验!

🤖 Kutools AI 功能AI助手 / 实时助手 / 超级润色(保留格式)/ 超级翻译(保留格式)/ AI遮挡 / AI校正...

📘 文档精通拆分页面 / 合并文档 / 以多种格式导出选择内容(PDF/TXT/DOC/HTML...)/ 批量转换为 PDF...

内容编辑跨多个文件批量查找和替换 / 调整所有图片大小 / 翻转表格的行和列 / 表格转文本...

🧹 轻松清理:清除多余空格 / 分节符 / 文本框 / 超链接 / 更多清理工具,请前往“清除”组...

创意插入:插入千位分隔符 / 复选框 / 单选按钮 / 二维码 / 条形码 / 多张图片 / 在“插入 ”组中发现更多...

🔍 精确选择:定位特定页面 / 表格 / 形状 / 标题段落 / 使用更多 选择 功能增强导航...

星级增强功能跳转到任意位置 / 自动插入重复文本 / 在文档窗口之间切换 / 11 转换 工具...

Kutools and Kutools Plus tabs on the Word Ribbon
👉 想尝试这些功能吗?立即下载 Kutools for Word!🚀
 

最佳办公生产力工具

Kutools for Word - 100+ Word 工具