Wie entferne ich doppelte Zeilen aus der Tabelle im Word-Dokument?

In Word-Dokumenten gibt es möglicherweise einige Tabellen mit doppelten Zeilen, die Sie entfernen und manchmal das erste Erscheinungsbild beibehalten möchten. In diesem Fall können Sie die doppelten nacheinander manuell entfernen und den VBA-Code verwenden.

Entfernen Sie doppelte Zeilen aus der Tabelle in Word

---

Entfernen Sie doppelte Zeilen aus der Tabelle in Word

1. Platzieren Sie den Cursor auf der Tabelle, aus der Sie die doppelten Zeilen entfernen möchten, und drücken Sie Alt + F11 Tasten zum Aktivieren der Microsoft Visual Basic für Applikationen Fenster.

2 Klicken Insert > Modul um ein neues Modul zu erstellen.

3. Kopieren Sie die folgenden Codes und fügen Sie sie in die neuen ein Modul Skripte.

VBA: Entfernen Sie doppelte Zeilen aus der Tabelle in 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

4. Drücken Sie F5 Schlüssel, um den Code auszuführen, dann werden alle doppelten Zeilen entfernt.

Hinweis: Der obige Code unterscheidet zwischen Groß- und Kleinschreibung. Wenn Sie doppelte Zeilen entfernen möchten, wenn Sie nicht zwischen Groß- und Kleinschreibung unterscheiden, können Sie den folgenden Code verwenden:

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

Wenn Sie doppelte Zeilen in allen Tabellen des Dokuments entfernen möchten, platzieren Sie den Cursor an einer beliebigen Stelle des Dokuments außerhalb der Tabelle und wenden Sie dann einen der oben genannten Codes an.

---