جزاكم الله خيراً أخي عبد الله وأخي جمال.
وكما قال أخي الحبيب جمال أني أفضل الكود ولكن حل المعادلات سوف يفيدني بإذن الله في استخدمات أخرى.
عملت إضافة بسيطة لكود الأخ الفاضل عبد الله والحمد لله تم المطلوب.
الكود بعد الإضافة:
Sub Macro1()
With ThisWorkbook.Sheets("Sheet2")
Dim cel As Range, ArRng As Range
Dim i As Long
Dim r As Range
On Error GoTo 1
With ThisWorkbook.Sheets("Sheet2").Range(Range("A1"), Range("A1").End(xlDown))
For Each cel In .Cells
i = i + 1
cel.Value = Split(CStr(cel), ".")(1) & "/" & Split(CStr(cel), ".")(0) & "/" & Split(CStr(cel), ".")(2)
If WorksheetFunction.CountIf(.Cells.Resize(i, 1), cel.Value) = 2 Then
If ArRng Is Nothing Then Set ArRng = cel Else Set ArRng = Union(ArRng, cel)
End If
Next
If Not ArRng Is Nothing Then ArRng.Delete
.Sort .Columns(1), xlAscending
LR = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set r = Range("A1:A" & LR)
r.RemoveDuplicates Columns:=Array(1), Header:=xlNo
End With
1:
Set ArRng = Nothing
End With
End Sub
وأكرر الشكر وأسأل الله أن ينفع بكم المسلمين وأن يتقبل منا ومنكم صالح الأعمال