كيفية إزالة الصفوف المكررة من الجدول في مستند Word؟

Author: Sun Last Modified: 2025-05-30

في مستند Word، قد توجد بعض الجداول التي تحتوي على صفوف مكررة والتي قد ترغب في إزالتها والاحتفاظ بالظهور الأول أحيانًا. في هذه الحالة، يمكنك اختيار إزالة الصفوف المكررة يدويًا واحدًا تلو الآخر، أو يمكنك استخدام كود VBA.

إزالة الصفوف المكررة من الجدول في Word

إزالة الصفوف المكررة من الجدول في Word

1. ضع المؤشر عند الجدول الذي تريد إزالة الصفوف المكررة منه، واضغط على مفاتيح Alt + F11 لتمكين نافذة Microsoft Visual Basic for Applications.

2. اضغط إدراج > وحدة لإنشاء وحدة جديدة.
Insert > Module options in the VBA window

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

VBA pasted into the Module window

4. اضغط F5 لتشغيل الكود، ثم سيتم إزالة جميع الصفوف المكررة.
All duplicate rows are removed from the table

ملاحظة: الكود أعلاه حساس لحالة الأحرف، إذا كنت ترغب في إزالة الصفوف المكررة دون التفريق بين حالة الأحرف، يمكنك استخدام الكود أدناه:

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...

Navigate through documents using Office Tab

حسّن سير عملك الآن.تعرّف على المزيد حول Office Tab تنزيل مجاني

قم بالمزيد في وقت أقل مع Kutools المُحسّن بالذكاء الاصطناعي لبرنامج Word

Kutools for Word ليس مجرد مجموعة من الأدوات - بل هو حل ذكي مصمم لتعزيز إنتاجيتك. بفضل الإمكانيات المدعومة بالذكاء الاصطناعي والميزات الأكثر أهمية، يساعدك Kutools على تحقيق المزيد في وقت أقل:

تلخيص وإعادة كتابة وتأليف وترجمة المحتوى فوراً.
تدقيق النصوص في الوقت الفعلي مع اقتراحات حول القواعد والنحو والأسلوب أثناء الكتابة.
إعادة صياغة وترجمة المحتوى مع الحفاظ على التخطيط والنمط والهيكل دون تغيير.
ترجمة المحتوى الخاص بك إلى أكثر من 40 لغة بسهولة، مما يوسع نطاق وصولك عالميًا.
الحصول على مساعدة فورية وأفكار ذكية بناءً على محتوى المستند الحالي.
اسأل عن كيفية إكمال مهمة - مثل إزالة فواصل الأقسام - وسيقوم الذكاء الاصطناعي بإرشادك أو القيام بذلك نيابةً عنك.
حجب المعلومات الحساسة أو السرية في غضون ثوانٍ لضمان الخصوصية الكاملة.
كل الأدوات تعمل بسلاسة داخل Word، دائمًا في متناول اليد.

إنشاء وتحسين وترجمة وتلخيص وتأمين المستندات بسهولة.
تحسين القواعد والوضوح والأسلوب أثناء الكتابة في الوقت الفعلي.
إعادة صياغة وترجمة المحتوى بدون أي تغييرات في التخطيط أو التنسيق.
اسأل عن كيفية إكمال مهمة - مثل إزالة فواصل الأقسام - وسيقوم الذكاء الاصطناعي بإرشادك أو القيام بذلك نيابةً عنك.
كل الأدوات تعمل بسلاسة داخل Word، دائمًا في متناول اليد.