Как удалить повторяющиеся строки из таблицы в документе Word?
AuthorSun•Last modified
В документе Word могут быть таблицы с повторяющимися строками, которые вы хотите удалить, оставив только первое вхождение. В этом случае можно выбрать удаление дубликатов вручную по одной строке или воспользоваться кодом VBA.
1. Поместите курсор в таблицу, из которой нужно удалить повторяющиеся строки, и нажмите клавиши Alt + F11, чтобы открыть окно Microsoft Visual Basic for Applications.
2. Нажмите Вставить > Модуль чтобы создать новый Модуль.
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
4. Нажмите F5 для запуска кода, после чего все повторяющиеся строки будут удалены.
Примечание: Приведенный выше код учитывает регистр. Если вы хотите удалить повторяющиеся строки без учета регистра, вы можете использовать следующий код:
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...
Делайте больше за меньшее время с Kutools для Word, усиленным ИИ
Kutools для Word — это не просто набор инструментов, это умное решение, созданное для повышения вашей продуктивности. Благодаря возможностям, управляемым искусственным интеллектом, и самым необходимым функциям, Kutools помогает вам делать больше за меньшее время:
Мгновенно суммируйте, переписывайте, составляйте и переводите контент.
Проверяйте текст в реальном времени с предложениями по грамматике, пунктуации и стилю во время написания.
Перефразируйте и переводите контент, сохраняя макет, стиль и структуру без изменений.
Легко переводите ваш контент более чем на 40 языков, расширяя свое глобальное присутствие.
Получайте мгновенную помощь и умные рекомендации на основе содержимого текущего документа.
Спросите, как выполнить задачу — например, удалить разрывы разделов — и ИИ проведет вас или сделает это за вас.
Редактируйте конфиденциальную информацию за считанные секунды, чтобы обеспечить полную конфиденциальность.
Все инструменты работают бесперебойно внутри Word, всегда под рукой.
Создавайте, улучшайте, переводите, суммируйте и защищайте документы без усилий.
Улучшайте грамматику, ясность и тон во время написания в реальном времени.
Перефразируйте и переводите контент без изменений макета или форматирования.
Спросите, как выполнить задачу — например, удалить разрывы разделов — и ИИ проведет вас или сделает это за вас.
Все инструменты работают бесперебойно внутри Word, всегда под рукой.
🌍 Поддержка более40 языков: Используйте Kutools на предпочитаемом языке — поддерживаются Английский, Испанский, Немецкий, Французский, Китайский и еще более40 языков!
👉 Хотите попробовать эти функции? Загрузите Kutools for Word сейчас! 🚀
