مساعدة: تحديد الأسماء المتشابهة في عمودين

[حكم القوي]

السلام عليكم

باختصار،، عندي عمودين فيهم أسماء أشخاص (ثلاثية وأكثر)، وأريد تظليل أو تحديد الأسماء المتشابهة حتى لو كان اسما واحدا فقط، يعني مثلا شخص اسمه محمد سعيد أحمد، وشخص اسمه حمد أحمد راشد، وأريد تظليل الاسم المشترك (أحمد)، فهل هناك معادلة معينة أكتبها أو أطبقها من المعادلات الموجودة في conditional formatting؟ علما بأنني استخدمت معادلة Duplicate الموجودة في conditional formatting، ولكنها للأسف لاتظلل إلا الأسماء المتطابقة 100%..

وجزاكم الله خير

[عبدالله المجرب]

ممكن عمل التلوين بالكود ان شاء الله

ضع مرفق 

[حكم القوي]

ممكن عمل التلوين بالكود ان شاء الله

ضع مرفق 

شكرا أخي الفاضل حاليا ماعندي مرفق وأحاول أساعد صديق في عمله،،

[عبدالله باقشير]

السلام عليكم

 

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

Sub kh_Cha_FontColor()
Dim cel As Range
Dim Nam As String
Dim Strt As Integer
Nam = Range("C2")
Application.ScreenUpdating = False
With Range("C4:D17")
    .Font.ColorIndex = 0
    If Len(Trim(Nam)) = 0 Then GoTo 1
    For Each cel In .Cells
        Strt = InStr(CStr(cel), Nam)
        If Strt Then
            cel.Characters(Strt, Len(Nam)).Font.ColorIndex = 3
        End If
    Next
End With
1:
Application.ScreenUpdating = True
End Sub

المرفق 2003

 

تظليل الأسماء المتشابهة.rar

[أبو حنــــين]

السلام عليكم

و هذه محاولة اخرى بالتنسيق الشرطي

تحديد الأسماء المتشابهة في عمودين.rar

[حكم القوي]

يزاكم الله،، هذا هو المطلوب لكنني أريد تظليل الأسماء بدون استخدام خلية مرجعية تضع فيها اسم معين، يعني أريد التظليل يكون بشكل عام بدون ما أحدد اسم معين،،

وجزاكم الله كل خير،،

[رجب جاويش]

أستاذى الحبيب / عبد الله باقشير

تسلم ايديك

 

أخى الحبيب / أبو حنين

تسلم ايديك

 

ولشرف المشاركة معكم

هذا كود آخر لتظليل الأسماء المتشابهه بين عمودين

فكرة الكود ليست نهائية ولكنها تحتاج لبعض التعديلات حيث تكون غير دقيقة عند كثرة الأسماء وتكرارها فى العمود الواحد ( ولكنها فكرة للبداية )

Sub ragab()
Sheets("sheet1").UsedRange.Font.ColorIndex = 1
xx = 7
Application.ScreenUpdating = False
For i = 1 To [A1000].End(xlUp).Row
    For ii = 0 To UBound(Split(Cells(i, 1)))
        x = Split(Cells(i, 1))(ii)
        For T = 1 To [B1000].End(xlUp).Row
            R = InStr(1, Range("B" & T), x)
            If R >= 1 Then
                Cells(T, 2).Characters(Start:=R, Length:=Len(x)).Font.ColorIndex = xx
                    For TT = 1 To [A1000].End(xlUp).Row
                        RR = InStr(1, Range("A" & TT), x)
                        If RR >= 1 Then
                            Cells(TT, 1).Characters(Start:=RR, Length:=Len(x)).Font.ColorIndex = xx
                        End If
                    Next
            End If
        Next
        xx = xx + 1
    Next
Next
Application.ScreenUpdating = True
End Sub

تظليل الأسماء المتشابهه فى عمودين.rar

[أبو حنــــين]

اخي رجب

جزاك الله خيرا

كود رائع

[رجب جاويش]

أخى الحبيب / أبو حنين

شكرا جزيلا أخى الحبيب على مرورك العطر وكلماتك الطيبة

[جمال عبد السميع]

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

لعله يسرى الموضوع بعد هذه الوجبة الدسمة من إبداعات عباقرتنا الأفاضل

أرجو أن تتقبلوا مرور تلميذكم وسطكم

 

تحديد الأسماء المتشابهة في عمودين 3.rar

[أبو أنس80]

شكرا جزيلا أخى  بارك الله فيك

[احمد الحاوي]

جزاكم الله كل خير 

[retal]

السلام عليكم

و هذه محاولة اخرى بالتنسيق الشرطي

طيب ممكن شرح الداله بالخطوات جزاك الله خيرا

[أبو حنــــين]

 

retal

السلام عليكم

 

1 - تقوم بتحديد المدى الذي تريد تطبيق التنسيق الشرطي عليه

2 - من القائمة تنسيق تختار تنسيق شرطي

3 - ثم من واجهة التنسيق الشرطي و من علامة الثبوت ( شرط واحد ) تختار : الصيغة

4 - تقوم بنسخ الدالة التالية :

=IF($A$1<>"";  FIND($A$1;D1:E13))

5 - تظغط على موافق