حذف المكرر حسب شروط ثلاث

[kkfhvvv]

السلام عليكم - رمضان مبارك

اريد حذف المكرر حسب شروط ثلاث

الاسم

الرقم

الجهة

فاذا تطابقت الشروط يتم حذف المكرر

وتقبل الله منكم صيامكم

حذف المكرر بموجب شروط ثلاث.xlsx

[حسونة حسين]

وعليكم السلام ورحمه الله وبركاته

تفضل اخى

Option Explicit

Sub Search_Delete()
    Dim Arr As Variant, SH As Worksheet, dic As Object
    Dim I As Long, Unique_No As String, R As Range, P As Long
    Application.ScreenUpdating = False: Application.EnableEvents = False
    Set SH = ThisWorkbook.Worksheets("ورقة1")

    Arr = SH.Range("B2:F" & SH.Cells(Rows.Count, 2).End(xlUp).Row).Value

    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    For I = LBound(Arr) To UBound(Arr)
        Unique_No = Arr(I, 1) & Arr(I, 4) & Arr(I, 5)
        If Not dic.Exists(Unique_No) Then
            dic.Add Unique_No, P
            P = P + 1
        Else
            If R Is Nothing Then
                Set R = SH.Cells(I + 1, 1)
            Else
                Set R = Union(R, SH.Cells(I + 1, 1))
            End If
        End If
    Next I
    If Not R Is Nothing Then R.EntireRow.Delete
    Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub

 

 

[kkfhvvv]

جزاك الله خير

100 %