ازالة الاكواد المكررة بشرط معين

[figo82eg]

ارجو المساعدة حيث لدى لملف اكسل به عدد عملاء يتعدى 200 الف عميل وعندى مشكلة فى تكرار اكواد هذه العملاء نتيجة تكرار تاريخ التركيب للعملاء بمعنى :

1- يمكن ان يتكرر الكود اكثر من مرة حين يتم زيارة العميل بأكثر من تاريخ

2- ممكن ان يكون تاريخ التركيب للسجل مرة خالى وممكن ان يكون به تاريخ زيارة

وعند عمل ازالة للأكواد المكررة من Remove Duplicates يتم حذف الاكواد المكررة بصورة عشوائية  

ما اريده هو حذف الاكواد المكرره بشرط ان ما يتبقى بعد الحذف هو كود اخر تاريخ تركيب او زيارة للكود

مرفق مثال بسيط للتطبيق

عملاء مكررين.XLSX

تم تعديل منذ 5 ساعات بواسطه figo82eg

[محمد هشام.]

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

جرب هل هدا ما تقصده 

Sub test()
    Dim WS As Worksheet, lastRow As Long, i As Long, dict As Object
    Dim cnt As String, dateStr As String, tmps As Date, maxDate As Date, tbl As Long

    Set WS = Sheets("Sheet1")
    lastRow = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row
    Set dict = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    For i = 2 To lastRow
    
        cnt = Trim(WS.Cells(i, 1).Value)
        dateStr = Trim(WS.Cells(i, 2).Value)
        tmps = IIf(IsDate(dateStr), CDate(dateStr), 0)

        If cnt <> "" Then
            If Not dict.exists(cnt) Then
                dict.Add cnt, Array(tmps, i)
            ElseIf tmps > dict(cnt)(0) Then
                dict(cnt) = Array(tmps, i)
            End If
        End If
    Next i

    For i = lastRow To 2 Step -1
        cnt = Trim(WS.Cells(i, 1).Value)
        If dict.exists(cnt) Then
            tbl = dict(cnt)(1)
            If i <> tbl Then WS.Range("A" & i & ":C" & i).Delete Shift:=xlUp  ' OR WS.Rows(i).Delete
        End If
    Next i
    
Application.ScreenUpdating = True
End Sub

 

[figo82eg]

شكرا لرد حضرتك ولكنى لسه مبتدئ فى الاكسل اين اضع هذا الكود فى الملف المرفق

تم تعديل منذ 4 ساعات بواسطه figo82eg