Skip to main content

如何從 Word 文件的表格中刪除重複的行?

Author: Sun Last Modified: 2025-05-12

在 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 不僅是一套工具,更是一個旨在提升您生產力的智慧解決方案。憑藉 AI 驅動的功能和最核心的特性,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 工具