إجمالي مرات مشاهدة الصفحة

الجمعة، 20 مايو 2016

تلوين القيم المكررة في عمود بألوان مختلفة Colour Duplicates

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

أقدم لكم كود يقوم بتلوين القيم المكررة في عمود بألون مختلفة ، أي أن كل قيمة مكررة يتم تلوينها بلون مختلف عن القيم الأخرى ، مما يسهل استخراج القيم المكررة بمجرد النظر إلى القيم
يوضع الكود في موديول عادي ، اضغط Alt + F11 من لوحة المفاتيح للذهاب لمحرر الأكواد ، ثم من قائمة Insert اختر الأمر Module لإدراج موديول عادي ثم الصق الكود التالي
Sub Colour_Duplicates()
    Dim R As Range, Dic As Object, W

    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1

    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Interior.ColorIndex = xlNone
        For Each R In .Cells
            If Not Dic.Exists(R.Value) Then
                ReDim W(1 To 2)
                Set W(1) = R

                With Application.WorksheetFunction
                    W(2) = Array(.RandBetween(0, 255), .RandBetween(0, 255), .RandBetween(0, 255))
                End With

                Dic(R.Value) = W
            Else
                W = Dic(R.Value)
                R.Interior.Color = RGB(W(2)(0), W(2)(1), W(2)(2))
                If Not IsEmpty(Dic(R.Value)(1)) Then Dic(R.Value)(1).Interior.Color = RGB(W(2)(0), W(2)(1), W(2)(2))
                W(1) = Empty
                Dic(R.Value) = W
            End If
        Next R
    End With
End Sub

إعداد / ياسر خليل أبو البراء

هناك 5 تعليقات:

  1. كيفية العمل بعد لصق الكود

    ردحذف
  2. بعد لصق الكود يمكن رسم شكل أو إنشاء زر على ورقة العمل ثم كليك يمين على الشكل واختر Assign Macro واختر اسم الإجراء الفرعي المسمى Colour_Duplicates ، ليتم التنفيذ بمجرد النقر على الزر أو الشكل

    ردحذف
  3. عمل رائع بارك الله فيك

    ردحذف
  4. وبارك الله فيك أخي العزيز محمد لطفي .. شرفني مرورك بالمدونة

    ردحذف
  5. eToro صفقات التداول المفتوحة في 227,585,248

    اكتشف eToro شبكة التداول الاجتماعي الرائدة في العالم حيث يحقق ملايين المستخدمين أرباحًا عن طريق نسخ تصرفات التداول التي يقوم بها أفضل المتداولين.

    ردحذف