Как да премахнете дублиращи се редове от таблица в документ на Word?

Автор: Слънце Последна промяна: 2020-10-09

В документа на Word може да има някои таблици с дублиращи се редове, които понякога искате да премахнете и да запазите първата поява. В този случай можете да изберете да премахнете дублиращите се един по един ръчно, също така можете да изберете да използвате кода на VBA.

Премахване на дублиращи се редове от таблицата в Word

Премахване на дублиращи се редове от таблицата в Word

1. Поставете курсора върху таблицата, от която искате да премахнете дублиращите се редове, натиснете Alt + F11 клавиши за активиране на Microsoft Visual Basic за приложения прозорец.

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 Tab поддържа подобна обработка, която ви позволява да преглеждате множество документи на Word или работни книги на Excel в един прозорец на Word или прозорец на Excel и лесно да превключвате между тях, като щраквате върху разделите им.
Кликнете за безплатен пробен период на Office Tab!