تحديد الخلايا المكرره

[محمد عبد الناصر]

السلام عليكم ؛
كنت عايز كود احدد بيه الخلايا الى الارقام فيها مكرره يعنى انا عندى فى خليه مكتوب 6.2.2.1
وخليه تانيه مكتوب فيها 6.2.2.1 
يلون الخليتين باللون الاحمر 

[ياسر خليل أبو البراء]

وعليكم السلام أخي الكريم محمد

لما لا تستخد التنسيق الشرطي لتنفيذ المطلوب ؟!

ارفق ملف للعمل عليه وحدد طريقة العمل المطلوب بها تنفيذ المطلوب ،وإن شاء المولى تجد المساعدة من إخوانك

[محمد عبد الناصر]

فى الملف المرفق يوجد اسطر مكرره اعتماد على الرقم الى مكتوب فى الخليه A 

عايز كود يلون السطر المكرر 

11.rar

[ياسر خليل أبو البراء]

جرب الكود التالي

Sub Duplicate_Values()
    Dim myRange As Range
    Dim myCell As Range

    Set myRange = Range("A24:A110")
    For Each myCell In myRange
        If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
            myCell.Resize(1, 9).Interior.ColorIndex = 3
        End If
    Next myCell
End Sub

تقبل تحياتي

 

أو جرب الكود التالي ..سيتم تلوين الخلية الأولى فقط في أول حدوث ثم بعد ذلك في حالة التكرار سيتلون النطاق إلى العمود I

وكل تكرار بلون مختلف ليسهل عليك استخراج المكرر

Sub Color_Duplicates()
    Dim r As Range, myColor, N As Long
    
    myColor = Array(4, 7, 12, 38, 39, 40, 46)
    Columns(1).Interior.ColorIndex = xlNone
    ReDim Preserve myColor(1 To UBound(myColor) + 1)
    
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        
        For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
            If r.Value <> "" Then
                If Not .exists(r.Value) Then
                    Set .Item(r.Value) = r
                Else
                    If TypeOf .Item(r.Value) Is Range Then
                        N = N + 1: If N > UBound(myColor) Then N = 1
                        Union(.Item(r.Value), r).Interior.ColorIndex = myColor(N)
                        .Item(r.Value) = myColor(N)
                    Else
                        r.Resize(1, 9).Interior.ColorIndex = .Item(r.Value)
                    End If
                End If
            End If
        Next
    End With
End Sub

[سليم حاصبيا]

جرب هذا الملف بالنتسيق الشرطي

11salim.rar

[محمد عبد الناصر]

1 ساعه مضت, ياسر خليل أبو البراء said:

جرب الكود التالي

Sub Duplicate_Values()
    Dim myRange As Range
    Dim myCell As Range

    Set myRange = Range("A24:A110")
    For Each myCell In myRange
        If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
            myCell.Resize(1, 9).Interior.ColorIndex = 3
        End If
    Next myCell
End Sub

تقبل تحياتي

 

بالظبط ده المطلوب ربنا يعزك كود رائع 

[ياسر خليل أبو البراء]

39 دقائق مضت, سليم حاصبيا said:

جرب هذا الملف بالنتسيق الشرطي

11salim.rar

هذا أجمل وابسط وأيسر ..بارك الله فيك يا سليم

[ابوانس2013]

تسلم 

الله طول عمركم

مجهود رائع