المجموع والمتوسط باستثناء شرط

[طالب للعلم]

السلام عليكم ورحمة الله وبركاته
أساتذتي الكبار الأفاضل
أرجو المساعدة لو تفضلتم
مرفق المطلوب

المجموع والمتوسط باستثناء شرط.xlsx

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

 جرب هذا الماكرو

Option Explicit
Sub Calc_Moyen()
Dim col%, rw%, m%, k%
Dim Total_sum#
Dim sBlank#, tBlank%
Dim sYellow#, tYellow%

 rw = Range("B4", Range("b3").End(4)).Rows.Count + 3
 col = Range("A4", Range("B4").End(2)).Columns.Count
 For m = 4 To rw
  For k = 2 To col - 4
  
  Total_sum = Total_sum + Cells(m, k)
  
   If Cells(m, k).Interior.ColorIndex <> 6 Then
       sBlank = sBlank + Cells(m, k)
       tBlank = tBlank + 1
   Else
      sYellow = sYellow + Cells(m, k)
      tYellow = tYellow + 1
   End If
  Next
  With Cells(m, col)
    .Offset(, -3) = Total_sum
    .Offset(, -2) = Total_sum / (tYellow + tBlank)
    .Offset(, -1) = sBlank
    .Value = IIf(tYellow <> 0, sBlank / tBlank, 0)
  End With
    sBlank = 0: tBlank = 0
    sYellow = 0: tYellow = 0
 Next
  Cells(4, col).Select
End Sub

الملف مرفق

 

 

sum_Aver.xlsm

[إيهاب عبد الحميد]

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

أ/ سليم .... كما هو مبدع دائما
ولكن لإثراء الفكرة وحيث أن عليها طلبات أعتقد ليست قليلة

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

المجموع والمتوسط باستثناء شرط.xlsm

تم تعديل فبراير 12, 2019 بواسطه إيهاب عبد الحميد

[طالب للعلم]

شكرا على مجهودكم الرائع ومنتداكم الذي يعد صرح ومنارة من منارات العلم في الوطن العربي

 

من فضلكم اريد نفس شغل أ ايهاب 

ولكن يكون بدل اللون يكون ادراج رقم اللون

 

[طالب للعلم]

أرجوا المساعدة من فضلكم

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

جرب هذا الملف من جديد

 

 

Sum_Average.xlsm

[طالب للعلم]

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

أكرر اسفي

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

أخي في اكسل هناك ملايين الالوان 

كبف لك ان تعرف رقم كل لون ؟

[طالب للعلم]

السلام عليكم ورحمو الله وبركاته
أستاذي الفاضل

يمكن أن أضع هذا الكود لإختبار رقم اللون

Sub RoundedRectangle1_Click()
Range("AJ2") = ActiveCell.Interior.ColorIndex
End Sub
 

 

أنا بالفعل اريد ان اتعامل مع أرقام ... وجزاكم الله خيرا

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

ارفغ ملفاً (20 صف   10 أعمدة تقريباً ) مع شرح لما تريد  لمعالجة الأمر