Word belgesindeki tablodan yinelenen satırları nasıl kaldırılır?
Author: SunLast Modified: 2025-06-10
Word belgesinde, bazen kaldırmak istediğiniz ve ilk görünümünü korumak istediğiniz bazı tablolar olabilir. Bu durumda, yinelenenleri tek tek manuel olarak kaldırabilir veya VBA kodunu kullanmayı tercih edebilirsiniz.
1. Yinelenen satırları kaldırmak istediğiniz tabloya imleci yerleştirin ve Microsoft Visual Basic for Applications penceresini etkinleştirmek için Alt + F11 tuşlarına basın.
2. Tıklayın Ekle > Modül yeni bir Modül oluşturmak için.
3. Aşağıdaki kodları kopyalayın ve yeni Modül betiğine yapıştırın.
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. Kodu çalıştırmak için F5 tuşuna basın, ardından tüm yinelenen satırlar kaldırılacaktır.
Not: Yukarıdaki kod büyük/küçük harf duyarlıdır. Eğer büyük/küçük harfe duyarsız yinelenen satırları kaldırmak istiyorsanız, aşağıdaki kodu kullanabilirsiniz:
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
Belgedeki tüm tablolardan yinelenen satırları kaldırmak istiyorsanız, imleci tablo dışında belgenin herhangi bir yerine yerleştirin ve yukarıdaki kodlardan birini uygulayın.
Office Tab: Word, Excel, PowerPoint gibi programlara sekmeli arayüzler getirir...
AI-Geliştirilmiş Kutools for Word ile Daha Az Zamanda Daha Fazla İş Yapın
Kutools for Word sadece bir araç seti değil - üretkenliğinizi artırmak için tasarlanmış akıllı bir çözüm. Yapay zeka destekli yetenekler ve en temel özelliklerle, Kutools size daha az zamanda daha fazla iş yapma imkanı sunar:
İçeriği anında özetleyin, yeniden yazın, oluşturun ve çevirin.
Yazarken gramer, noktalama ve stil önerileriyle metni gerçek zamanlı olarak düzeltin.
Düzeni, stili ve yapıyı bozmadan içeriği yeniden ifade edin ve çevirin.
İçeriğinizi 40'tan fazla dile kolayca çevirerek küresel olarak erişiminizi genişletin.
Geçerli belge içeriğine dayalı anında yardım ve akıllı içgörüler alın.
Bir görevi tamamlama konusunda soru sorun - bölüm sonlarını kaldırma gibi - ve yapay zeka size rehberlik edecek ya da sizin için yapacaktır.
Hassas veya gizli bilgileri birkaç saniye içinde düzenleyerek tamamen gizliliği sağlayın.
Tüm araçlar Word içinde sorunsuz çalışır ve her zaman ulaşılabilir durumdadır.
Belgeleri oluşturun, iyileştirin, çevirin, özetleyin ve güvenli hale getirin.
Yazarken gerçek zamanlı olarak grameri, netliği ve tonu geliştirin.
Hiçbir düzen veya biçimlendirme değişikliği olmadan içeriği yeniden ifade edin ve çevirin.
Bir görevi tamamlama konusunda soru sorun - bölüm sonlarını kaldırma gibi - ve yapay zeka size rehberlik edecek ya da sizin için yapacaktır.
Tüm araçlar Word içinde sorunsuz çalışır ve her zaman ulaşılabilir durumdadır.
