سؤال هل يمكن تجميع الخلايا الملونه

[alaaaltwel]

السادة 

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

كما فى الشيت المرفق 

جعلكم الله عونا لنا كعهدنا بكم دائما

ديسمبر 2016.rar

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

السلام عليكم

اطلع على الرابط التالي فيه ما تريد إن شاء الله

من هنا

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

بعد اذن الاخ ابو البراء

انسخ هذا الكود الى موديل جديد 

 Function Color_Num(rg As Range, source_rg As Range)
 my_color = source_rg.Interior.ColorIndex
 For i = 1 To rg.Count
  If rg.Cells(i).Interior.ColorIndex = my_color Then s = s + 1
  Next
  Color_Num = s
 End Function

ثم في الخلية CS8 اكتب هذه المعادلة و اسحب يساراً (و نزولاً اذا كنت تريد العمل على اكثر من صف)

=IF($B8="","",Color_Num($D8:$CR8,CS$5))

اليك الملف مع المعادلة

 

ديسمبر 2016 سليم.rar

[alaaaltwel]

شكرا جدا

انا حاولت كتير على العمل على رود سيادتكم لكن لما اوصل الى حل نهائيا

الاستاذ / سليم حاصبيا

الشيت لا يعمل

وشكرا لسيادتكم

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

3 ساعات مضت, alaaaltwel said:

شكرا جدا

انا حاولت كتير على العمل على رود سيادتكم لكن لما اوصل الى حل نهائيا

الاستاذ / سليم حاصبيا

الشيت لا يعمل

وشكرا لسيادتكم

ربما كان الاصدار عندك قديم

تم تعديل الملف حتى يعمل مع الاكسل 97 2003

 

ديسمبر 2016 سليم 2003.rar

[mohamed elforse]

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

ربما كان الاصدار عندك قديم

تم تعديل الملف حتى يعمل مع الاكسل 97 2003

 

ديسمبر 2016 سليم 2003.rar

الاستاذ الكبير / سليم حاصبيا

بعد التحية ,,,

الرجاء العلم ان عند تغيير اي خانة من الخانات الموجودة لم يتم تغيير عد الالوان الا بعد عمل calculation للصفحة ..... لذا هل من الممكن وجود طريقة بحيث عند تغيير لون اي خانة يتم تغيير عملية عد الالوان بدون عمل calculation للصفحة .

وشكرا

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

اضف هذا السطر البسيط على الكود

 Application.Volatile

ليصبح الكود بهذا الشكل

 Function Color_Num(rg As Range, source_rg As Range)
 Application.Volatile
 my_color = source_rg.Interior.ColorIndex
 For i = 1 To rg.Count
  If rg.Cells(i).Interior.ColorIndex = my_color Then s = s + 1
  Next
  Color_Num = s
 End Function

 

[mohamed elforse]

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

اضف هذا السطر البسيط على الكود

 Application.Volatile

ليصبح الكود بهذا الشكل

 Function Color_Num(rg As Range, source_rg As Range)
 Application.Volatile
 my_color = source_rg.Interior.ColorIndex
 For i = 1 To rg.Count
  If rg.Cells(i).Interior.ColorIndex = my_color Then s = s + 1
  Next
  Color_Num = s
 End Function

 

الاخ الكبير /  سليم حاصبيا

تحية طيبة وبعد ,,,

الرجاء العلم ان بعد اضافة Application.Volatile علي الكود لم تعمل حيث انني قمت بالوقوف علي خلية و فتحت fill color في مجموعة font و قمت باختيار اللون الاصفر و لكن لم يتم تغيير الرقم الا بعد الضغط علي F9 فهل من حل اخر بحيث تقوم بتغيير الرقم بمجرد اختيار اللون 

مع العلم انني بالامس بحثت علي الانترنت علي كود يقوم بعمل Refresh للصفحة بحيث بمجرد اختيار اللون يتم تغيير الرقم تلقائيا ولكن دون جدوي و ذلك لعدم علمي الشديد بلغة VBA 

ولكم جزيل الشكر و التقدير 

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

يمكن إضافة هذا السطر في حدث تغير ورقة العمل

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.CalculateFull
End Sub

أو من لوحة المفاتيح Ctrl + Shift + F9

[alaaaltwel]

شكرا جدا

انا حاولت كتير على العمل على رود سيادتكم لكن لما اوصل الى حل نهائيا

ولكن يوجد خطاء ما

فبرجاء الافادة ان امكن.

مارس 2017.rar

 

تم تعديل مارس 18, 2017 بواسطه alaaaltwel

[عبدللرحيم]

تفضل جرب يا أخى 

alaaaltwel

 

OK_مارس 2017.rar