تلوين القيم المتكررة رأسيا وأفقيا فى نفس الوقت

**يوسف عطا** · يونيو 9, 2019

الرجاء كتابة صيغة للتنسيق الشرطى

لتلوين الخلايا التى بها أرقام متساوية فى نفس السطر

بلون معين

**أحمد يوسف** · يونيو 9, 2019

تفضل استاذى الكريم

ولكن كان عليك رفع ملف وشرح المطلوب عليه بكل دقة تجنبا لإهدار الوقت

تنسيق شرطى للقيم المكررة فى نفس الصف.xlsx

**سليم حاصبيا** · يونيو 9, 2019

جرب هذا الكود

Option Explicit
Sub Colorize_Range()
'Created By Salim Hasbaya 9/6/2109
Dim i%, x%, k%, m%, My_ad$, First_ad$
Dim My_rg As Range, cel As Range
Set My_rg = Range("a1:G12")
Dim f_rg As Range
x = 4
My_rg.Interior.ColorIndex = xlNone
 For Each cel In My_rg
    If cel.Interior.ColorIndex <> xlNone Or _
     Application.CountIf(My_rg, cel) = 1 Then _
     GoTo next_cel
       Set f_rg = My_rg.Find(cel, lookat:=xlWhole)
            My_ad = f_rg.Address: First_ad = My_ad
        Do
          Range(My_ad).Interior.ColorIndex = x
          Set f_rg = My_rg.FindNext(f_rg)
          My_ad = f_rg.Address
       Loop Until My_ad = First_ad
    x = x + 1: If x = 57 Then x = 10
next_cel:
 Next cel
 End Sub

الملف مرفق

CororisMe.xlsm

**Ali Mohamed Ali** · يونيو 9, 2019

أحسنت استاذ سليم كود ممتاز بارك الله فيك

**يوسف عطا** · يونيو 9, 2019

4 hours ago, أحمد يوسف said:

تفضل استاذى الكريم

ولكن كان عليك رفع ملف وشرح المطلوب عليه بكل دقة تجنبا لإهدار الوقت

تنسيق شرطى للقيم المكررة فى نفس الصف.xlsx 9.22 kB · 1 download

السلام عليكم يا أستاذنا
نعتذر عن عدم ارفاق ملف فى الطلب حيث إعتقدت أن الفكرة واضحة
و مرفق ملف للعمل عليه
المطلوب معادلة فى صيغة التنسيق الشرطى تقوم بتلوين الخلية التى بها رقم مكرر فى نفس السطر
فى مدى معين
مثلاً فى المدى من

C5:Y30

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

و إذا تكرر رقم فى نفس الصف يتم تلوين الخلايا المكررة بلوم أزرق

علماً بأن بأن العملية ستتكرر فى مدى آخر و ليكم من
C35:Y60

ولكن إن كان التكرار خارج المدى المحدد لا يتم تلوين الخلايا حتى لو كانت الخلية المكررة فى المدى الآخر

ساقية ر افت - Copy.xls

تم تعديل يونيو 9, 2019 بواسطه يوسف عطا

**يوسف عطا** · يونيو 9, 2019

4 hours ago, سليم حاصبيا said:

جرب هذا الكود


Option Explicit
Sub Colorize_Range()
'Created By Salim Hasbaya 9/6/2109
Dim i%, x%, k%, m%, My_ad$, First_ad$
Dim My_rg As Range, cel As Range
Set My_rg = Range("a1:G12")
Dim f_rg As Range
x = 4
My_rg.Interior.ColorIndex = xlNone
 For Each cel In My_rg
    If cel.Interior.ColorIndex <> xlNone Or _
     Application.CountIf(My_rg, cel) = 1 Then _
     GoTo next_cel
       Set f_rg = My_rg.Find(cel, lookat:=xlWhole)
            My_ad = f_rg.Address: First_ad = My_ad
        Do
          Range(My_ad).Interior.ColorIndex = x
          Set f_rg = My_rg.FindNext(f_rg)
          My_ad = f_rg.Address
       Loop Until My_ad = First_ad
    x = x + 1: If x = 57 Then x = 10
next_cel:
 Next cel
 End Sub

الملف مرفق

CororisMe.xlsm 20.17 kB · 1 download

الف شكر على تعبك استاذنا الكريم سليم بك
الرجاء تعديل الكود كالآتى
1. ضبط المدى الذى سينفذ فيه الكود بحيث أنه يمكن أن نطلب تنفيذ الكود فى أكثر من مدى ولكن كل منهما مستقل عن الآخر
2. داخل نفس المدى المحدد إذا تكرر الرقم فى نفس السطر يكون لون الخلايا أزرق و إذا كان التكرار فى نفس العمود يكون لون الخلايا أحمر

ومرفق ملف للتنفيذ عليه حيث عندى أوفيس 2003

و مرفق صورة لشرح نقطة
مثلاً رقم 55 تم تلوين خليته حيث تكرر فى نفس الصف و تكرر كذلك فى نفس العمود
لكن رقم 44 لماذا تم تلوينه ؟؟
لقد تكرر ولكن ليس فى نفس الصف و ليس فى نفس العمود فلم يكن يجب أن يتلون
أتعشم أن الفكرة قد تكون وضحت
تقبل تحياتى

image.png.88ab933fc469d9e630c0c5875f3608fb.png

ساقية ر افت - Copy.xls

تم تعديل يونيو 9, 2019 بواسطه يوسف عطا

**يوسف عطا** · يونيو 10, 2019

للرفع
رفع الله قدركم

**Ali Mohamed Ali** · يونيو 11, 2019

تفضل استاذى الكريم بالتنسيق الشرطى

ساقية.xls

**يوسف عطا** · يونيو 12, 2019

الف شكر على مجهودك على بك
ربنا يحفظك
هل ممكن إستثناء حرف ال ( ح ) من التنسيق الشرطى ؟

سواء الأفقى أو الرأسى

**يوسف عطا** · يونيو 14, 2019

للرفع رفع الله قدركم

في ١١‏/٦‏/٢٠١٩ at 14:10, Ali Mohamed Ali said:

تفضل استاذى الكريم بالتنسيق الشرطى

ساقية.xls 79.5 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 3 downloads

الف شكر للاستاذ على محمد على
ربنا يجعل أعمالك فى موازين حسناتك ويصلح ما بين إيديك
الرجاء فى صيغة التنسيق الشرطى أن يتم العمل على الأرقام فقط و إستثناء حرف ح من التنسيق الشرطى
وبما أن استاذنا الغالى على محمد حفظه الله لم يتسنى له الوقت لتعديل الصيغة فالرجاء منكم أخوتى من يعرف كيف يكون التعديل فليتفضل مشكوراً

**محمد طاهر عرفه** · يونيو 14, 2019

في ١٠‏/٦‏/٢٠١٩ at 02:23, يوسف عطا said:

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

و إذا تكرر رقم فى نفس الصف يتم تلوين الخلايا المكررة بلوم أزرق

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

**يوسف عطا** · يونيو 14, 2019

منذ ساعه, محمد طاهر said:

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

فى الملف المطلوب فيه هذا التنسيق إذا تكرر الرقم فى نفس العموم معناه وجود خطأ جسيم لا يمكن تركه هكذا و سيتم تلافى هذا الخطأ بتغيير الرقم المكرر بالبحث عن الرقم المنسى و ستبداله مكانه
أما لو تكرر الرقم فى نفس الصف فمعناه وجود خطأ كذلك ولكن إذا لم نتمكن من تلافيه و تغييره فيمكن الإستمرار فى العمل
عموماً للتسهيل فى حالة تكرار الرقم افقى و راسى فلا يهم أى لون سيأخذه المهم أنه يتميز بلون
طب هل ممكن يكون فى لون تالت فى حالة حدث التكرار أفقى و راسى لنفس الرقم ؟؟ فقط من باب العلم بالشئ
فلو كان هذا ممكن فنجعله هكذا
التكرار الافقى أزرق
التكرار الرأسى أحمر
التكرار افقى و راسى أصفر
المهم جداً أن يكون التنسيق للأرقام فقط ولا يتم تلوين حرف ( ح ) أو الحروف بوجه عام

**محمد طاهر عرفه** · يونيو 14, 2019

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

اعتقد انه يمكن اختصاره بعض الشيء ، و لكن اتصور انه يؤدي المطلوب

اولا ظلل الخلايا المطلوب تحليلها ثم شغل الكود و قم باختباره

ملاحظة بعد النشر : وضعت الوان مختلفة حيث لم انتبه للون الاصفر و ووضعت بدلا منه اخضر ، يمكنك تعديله كما تشاء علما بان كود اللون الاصفر 65535

Sub Color_Dubplicatesl()
' color duplicates hzl adn vl as requested by youssef Atta on 14 june
Dim myrow, mycol As Integer
mycol = Selection.Columns.Count
myrow = Selection.Rows.Count
Selection.Interior.ColorIndex = xlNone

'=================
' Hzl Dubplicate
For i = 0 To myrow - 1
For j = 0 To mycol - 1

If Not IsNull(ActiveCell.Offset(i, j).Value) And ActiveCell.Offset(i, j).Value <> "" Then
If IsNumeric(ActiveCell.Offset(i, j).Value) Then
  
  For k = j + 1 To mycol - 1 ' compare this col
   If ActiveCell.Offset(i, j).Value = ActiveCell.Offset(i, k).Value Then
    ActiveCell.Offset(i, j).Cells.Interior.Color = 255 ' red
    ActiveCell.Offset(i, k).Cells.Interior.Color = 255 ' red
    Exit For
   End If
  Next k ' compare this col
  
  
End If ' if numeric
End If ' not if null

Next j
Next i
'==============
' Vl Duplicates
'=================

For i = 0 To mycol - 1
For j = 0 To myrow - 1

If Not IsNull(ActiveCell.Offset(j, i).Value) And ActiveCell.Offset(j, i).Value <> "" Then
If IsNumeric(ActiveCell.Offset(j, i).Value) Then
  
  For k = j + 1 To myrow - 1 ' compare this col
   If ActiveCell.Offset(j, i).Value = ActiveCell.Offset(k, i).Value Then
    
    If ActiveCell.Offset(j, i).Cells.Interior.Color = 255 Then
    ActiveCell.Offset(j, i).Cells.Interior.Color = 5287936 ' green
    Else
    ActiveCell.Offset(j, i).Cells.Interior.Color = 15773696 ' cyan
    End If
    
    If ActiveCell.Offset(k, i).Cells.Interior.Color = 255 Then
    ActiveCell.Offset(k, i).Cells.Interior.Color = 5287936 ' green
    Else
    ActiveCell.Offset(k, i).Cells.Interior.Color = 15773696 ' cyan
    End If
    
    Exit For
   End If
  Next k ' compare this col
    End If ' if numeric
End If ' not if null
Next j
Next i

End Sub

ساقية.xls

**Ali Mohamed Ali** · يونيو 14, 2019

عمل رائع استاذ محمد بارك الله فيك

ولإثراء الموضوع هذا حل اخر بدون اكواد

ساقية.xls

**يوسف عطا** · يونيو 14, 2019

11 ساعات مضت, محمد طاهر said:

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

اعتقد انه يمكن اختصاره بعض الشيء ، و لكن اتصور انه يؤدي المطلوب

اولا ظلل الخلايا المطلوب تحليلها ثم شغل الكود و قم باختباره

ملاحظة بعد النشر : وضعت الوان مختلفة حيث لم انتبه للون الاصفر و ووضعت بدلا منه اخضر ، يمكنك تعديله كما تشاء علما بان كود اللون الاصفر 65535


Sub Color_Dubplicatesl()
' color duplicates hzl adn vl as requested by youssef Atta on 14 june
Dim myrow, mycol As Integer
mycol = Selection.Columns.Count
myrow = Selection.Rows.Count
Selection.Interior.ColorIndex = xlNone

'=================
' Hzl Dubplicate
For i = 0 To myrow - 1
For j = 0 To mycol - 1

If Not IsNull(ActiveCell.Offset(i, j).Value) And ActiveCell.Offset(i, j).Value <> "" Then
If IsNumeric(ActiveCell.Offset(i, j).Value) Then
  
  For k = j + 1 To mycol - 1 ' compare this col
   If ActiveCell.Offset(i, j).Value = ActiveCell.Offset(i, k).Value Then
    ActiveCell.Offset(i, j).Cells.Interior.Color = 255 ' red
    ActiveCell.Offset(i, k).Cells.Interior.Color = 255 ' red
    Exit For
   End If
  Next k ' compare this col
  
  
End If ' if numeric
End If ' not if null

Next j
Next i
'==============
' Vl Duplicates
'=================

For i = 0 To mycol - 1
For j = 0 To myrow - 1

If Not IsNull(ActiveCell.Offset(j, i).Value) And ActiveCell.Offset(j, i).Value <> "" Then
If IsNumeric(ActiveCell.Offset(j, i).Value) Then
  
  For k = j + 1 To myrow - 1 ' compare this col
   If ActiveCell.Offset(j, i).Value = ActiveCell.Offset(k, i).Value Then
    
    If ActiveCell.Offset(j, i).Cells.Interior.Color = 255 Then
    ActiveCell.Offset(j, i).Cells.Interior.Color = 5287936 ' green
    Else
    ActiveCell.Offset(j, i).Cells.Interior.Color = 15773696 ' cyan
    End If
    
    If ActiveCell.Offset(k, i).Cells.Interior.Color = 255 Then
    ActiveCell.Offset(k, i).Cells.Interior.Color = 5287936 ' green
    Else
    ActiveCell.Offset(k, i).Cells.Interior.Color = 15773696 ' cyan
    End If
    
    Exit For
   End If
  Next k ' compare this col
    End If ' if numeric
End If ' not if null
Next j
Next i

End Sub

ساقية.xls 78 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 2 downloads

الف شكر استاذنا الغالى
جارى التجربة

10 ساعات مضت, Ali Mohamed Ali said:

عمل رائع استاذ محمد بارك الله فيك

ولإثراء الموضوع هذا حل اخر بدون اكواد

ساقية.xls 229 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 0 downloads

الف شكر استاذ على
جزاك الله خير

**محمد طاهر عرفه** · يونيو 15, 2019

6 ساعات مضت, Ali Mohamed Ali said:

ولإثراء الموضوع هذا حل اخر بدون اكواد

جميل جدا فالحل بدون كود أفضل عندما يكون متاحا

و احب ان نستمر فى مناقشة حل التنسيق الشرطي، هل يمكن ايضا من خلاله تجديد الخلايا الخضراء ( اي التى بها تكرار رأسي و افقي فى نفس الوقت)

تسجيل الدخول

تلوين القيم المتكررة رأسيا وأفقيا فى نفس الوقت

الردود الموصى بها

يوسف عطا

أحمد يوسف

سليم حاصبيا

Ali Mohamed Ali

يوسف عطا

يوسف عطا

يوسف عطا

Ali Mohamed Ali

يوسف عطا

يوسف عطا

محمد طاهر عرفه

يوسف عطا

محمد طاهر عرفه

Ali Mohamed Ali

يوسف عطا

محمد طاهر عرفه

Join the conversation

محتوي مشابه

تلوين الحقول الفارغة كتنبيه

طريقة تلوين السجل الاول والسجل الاخير في نماذج أكسس

كيفية تلوين صفوف بشكل مشروط

تنسيق شرطى

تنسيق شرطي لمجموعة خلايا

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information