如何從Word文檔中的表中刪除重複的行？

在Word文檔中，可能要刪除一些具有重複行的表，並有時保留第一個外觀。在這種情況下，您可以選擇手動刪除一個重複的副本，也可以選擇使用VBA代碼。

從Word中的表中刪除重複的行

1.將光標放在要從中刪除重複行的表上，按 Alt + F11鍵 啟用 Microsoft Visual Basic for Applications 窗口。

2。點擊插入 > 模塊創建一個新的模塊。
doc刪除重複的行table01

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

doc刪除重複的行table02

4。按 F5 鍵運行代碼，然後所有重複的行將被刪除。
doc刪除重複的行table03

備註：上面的代碼區分大小寫，如果要刪除不區分大小寫的重複行，則可以使用下面的代碼：

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

如果要刪除文檔所有表中的重複行，請將光標放在表外文檔的任何位置，然後應用上述代碼之一。

分頁瀏覽和編輯多個Word文檔/ Excel工作簿，如Firefox，Chrome，Internet Explore 10！

您可能很熟悉在Firefox / Chrome / IE中查看多個網頁，並通過輕鬆單擊相應的選項卡在它們之間進行切換。在這裡，Office選項卡支持類似的處理，使您可以在一個Word窗口或Excel窗口中瀏覽多個Word文檔或Excel工作簿，並通過單擊它們的選項卡輕鬆地在它們之間進行切換。
單擊免費試用Office選項卡！