دالة لعد الخلايا الملونة بلون معين

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

هذا المثال فى الملف المرفق اعددته بناء على طلب أحد الزملاء ،ليقوم بعد الخلايا التي لها لون معين

و أطرح هنا مثالين فيما يلي :

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

CountByCellColor2.rar

و طبعا عند التجربة و تعديل لون الخلية يحب تحرير الخلية لاعادة تفعيل الدالة

و ذلك عن طريق F2 ثم Enter

يتم تطبيق الدالة فى المثال الاول كما يلي

=countmycolor2(coloredarea)

اذا كان المجال له اسم 

مثل

coloredarea 

او مباشرة كما يلي


=countmycolor2(E7:J17)

و الدالة فى المثال الاول هي

Function countmycolor2(Myrange As range)

Dim Mycolor As Integer

Mycolor = activecell.Interior.ColorIndex

Dim Myrow As Long, MyCol As Long

Myrow = Myrange.Rows.Count

MyCol = Myrange.Columns.Count

Mycells = Myrange.Cells.Count


Dim colorcounter As Integer, counterx As Integer


For i = 0 To Myrow - 1

 For j = 0 To MyCol - 1

 counterx = counterx + 1

   If Myrange.Cells(counterx).Interior.ColorIndex = Mycolor Then

          colorcounter = colorcounter + 1

    End If

  Next j

Next i


countmycolor2 = colorcounter


End Function

المثال الثاني و الثاني هو يقوم بعد الخلايا الملونة بلون معين فى نطاق محدد باستخدام الكود، و يحتاج الي متغيرين الأول هو المجال المطلوب عد الخلايا بداخله و الثاني هو كود اللون المطلوب عد الخلايا التي تم تلوينها به CountByCellColor.rar و يتم تطبيق الدالة فى المثال الثاني كالتالي: مثال

=countmycolor(coloredarea,3)

اذا كان المجال له اسم 

مثل

coloredarea 

او مباشرة كما يلي

=countmycolor(E7:J17,8)

Function countmycolor(Myrange As range, Mycolor As Integer)


If IsNull(Mycolor) Or Mycolor > 56 Or Not IsNumeric(Mycolor) Then

 MsgBox " choose a number between 0 and 56"

End If


Dim Myrow As Long, MyCol As Long

Myrow = Myrange.Rows.Count

MyCol = Myrange.Columns.Count

Mycells = Myrange.Cells.Count


Dim colorcounter As Integer, counterx As Integer


For i = 0 To Myrow - 1

 For j = 0 To MyCol - 1

 counterx = counterx + 1

   If Myrange.Cells(counterx).Interior.ColorIndex = Mycolor Then

          colorcounter = colorcounter + 1

    End If

  Next j

Next i


countmycolor = colorcounter


End Function

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

Sub Listcolors()

ActiveCell.Offset(0, 0).Value = "ColorIndex"

ActiveCell.Offset(0, 1).Value = "Color"


For i = 1 To 56

   ActiveCell.Offset(i, 0).Value = i

   ActiveCell.Offset(i, 1).Interior.ColorIndex = i

Next i


End Sub

[عادل حنفي]

السلام عليكم

بارك الله فيك و حعله الله في ميزان حسناتك

تحياتي

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

تم اضافة فكرة أخري بناء على ملاحظة من أخونا الحسامي مشكوراً

[عادل حنفي]

السلام عليكم

و اسمح لي ايضا استاذنا

لسهولة الوصول للون خلية معينة مباشرة

عند تحديد خلية معينه و الضغط علي زر تظهر رسالة تعطي درجة لون

الخلية و ان كان ليس بها ايلون تظهر رسالة اخري تفيد بانها XLNONE

اي بدون لون

خالص تحياتي و تقديري

Book1.rar

[الحسامي]

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

استاذنا العزيز محمد طاهر عمل مبدع وصنع دالة لهذا الغرض لهو عمل

كبير ومبدع وجزاك الله خيرا

اخي عادل حنفي

عمل متميز كعادتك

وهنا مشاركة مني فقط عند اختيار لون بواسطة المؤشر يقوم بالعد ووضع الناتج واللون

CountByCellColor-hosami.rar

[عادل حنفي]

السلام عليكم

اخي الحسامي

و انت ايضا فكرتك رائعة كعادتك التي نتمني ان لا نحرم منها ابدا

و اسمح لي باضافة بسيطة

تحياتي

COLOR.rar

[الحسامي]

السلام عليكم

اخي العزيز عادل

وانا اخوي الكبير اسمه عادل على فكرة

اضافاتك دائما موضوع مستقل وابداع بحد ذاته

وبارك الله فيك

[عادل حنفي]

السلام عليكم

اخي العزيز عادل

وانا اخوي الكبير اسمه عادل على فكرة

هذا شرف لي و بالفعل نحن جميعا اخوة

خالص تحياتي و تقديري

[عادل حنفي]

السلام عليكم

اود ان اشكر الاستاذ الفاضل محمد طاهر

لان بالفعل دائما طرحه لمواضيع ان بدت صغيرة و لكنها كبيرة

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

و دائما تدخلاته تجعل همة معينه للمداخلات

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

خالص تحياتي و تقديري

[الحسامي]

السلام عليكم

اخي عادل وانا بتشرف فيك كمان

وعلى فكرة الموضوع مميز ليس بمبدأ عمل الكود

وانما تميزه كونه داله وليس كود

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

[سالم شباني]

السلام عليكم

إبداع من أناس مبدعين وطيبين ، نحن نستأنس بوجودكم

حفظكم الله من كل سوء وأدام نعمه عليكم

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

اخوتي الكرام

جزاكم الله خيرا على الاضافات الجميلة ، و نفع بكم و زادكم علماً

[يحيى حسين]

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

ما شاء الله

ابداعات جميلة و موضوع مهم جدا

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

[ولدطيبة]

h

الأستاذ محمد طاهر

ابداعات جميلة و فكرة نيرة

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

اخواني و اساتذتي

عادل حنفي و عماد الحسامي

جزاكم الله كل خير على ابداعاتكم الجميلة

[egyptian_eg]

مشكورين إخوتي الكرام

و لدي تساؤل

اذا كان لدي جدول تقييم لمشاريع به خلايا تلون باستخدام التنسيق الشرطي

و بنهاية الجدول ثلاثة خانات

الاولي تعد الخلايا الحمراء ، و الثانية الصفراء، و الثالثة الخضراء

فأي الأفكار المطروحة يكون الافضل للتطبيق

استخدام الدالة أم الروتين الفرعي؟ و لماذا ؟

[ابو الآء]

بارك الله فى جميع الاستاذة بهذا المنتدى الجميل

[عاشق الود]

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

 

أخواني الأعزاء مبدعي البرمجة

 

أرجو المساعدة

 

أريد دالة غير التنسيق الشرطي لأنه يسمح بثلاثة شروط فقط وأنا أريده لأكثر من عشرين شرط

حيث يتمثل الشرط في قيمة الخلية

إذا كانت قيمة الخلية على سبيل المثال

1 يجعل لون الخلية أصفر

2 يجعل لون الخلية أخضر

3 يجعل لون الخلية بنفسجي

 

وهكذا..

 

فهل من مساعد في ذلك

 

ولكم جزيل الشكر