عندها يجب الزيادة على الكود بهذا الشكل
الكود يحسب اي خلية لونها مختلف عن الأبيض
مما يعطيك فرصة لتغيير الالوان حسب الحاجة
مثلاَ: ما تريد من الناجحين لون اصفر
ما تريد من الراسبين لون أحمر
ما تريد من الغائبين لون أخضر وهكذا.....
لك الخيار باختيار اللون رقم 24 الأزرق (حسب التعديل الذي أقترحته انت)
CODE
Dim D As Worksheet
Dim Im As Worksheet
Dim i, s#
Sub find_nageh()
Set D = sheets("data")
Set Im = sheets("Import")
For i = 1 To 4
Call Find_sum_nageh(D.Range("E4:H100"), i, Im.Range("C5"))
Im.Range("J12").Offset(i - 1) = s
s = 0
Call Find_sum_Raseb(D.Range("E4:H100"), i, Im.Range("C5"))
Im.Range("K12").Offset(i - 1) = s
s = 0
Call Find_sum_Gha3eb(D.Range("E4:H100"), i, Im.Range("C7"))
Im.Range("L12").Offset(i - 1) = s
s = 0
Call Find_sum_special(D.Range("E4:H100"), i, Im.Range("C6"))
Im.Range("K12").Offset(i - 1) = Im.Range("K12").Offset(i - 1) + s
s = 0
Next
Set D = Nothing: Set Im = Nothing
End Sub
'+++++++++++++++++++++++++++++
Sub Find_sum_nageh(Tot_rg As Range, ByVal n%, Alama#)
For Each cel In Tot_rg.Columns(n).Cells
If IsNumeric(cel) And cel >= Alama Then
If cel.Interior.ColorIndex <> xlNone Then
s = s + 1
End If
End If
Next
End Sub
'+++++++++++++++++++++++++++++
Sub Find_sum_Gha3eb(Tot_rg As Range, ByVal n%, Alama)
For Each cel In Tot_rg.Columns(n).Cells
If cel = Alama Then
If cel.Interior.ColorIndex <> xlNone Then
s = s + 1
End If
End If
Next
End Sub
'++++++++++++++++++++++++++++++
Sub Find_sum_Raseb(Tot_rg As Range, ByVal n%, Alama)
For Each cel In Tot_rg.Columns(n).Cells
If IsNumeric(cel) And cel < Alama Then
If cel.Interior.ColorIndex <> xlNone Then
s = s + 1
End If
End If
Next
End Sub
'+++++++++++++++++++++++++++
Sub Find_sum_special(Tot_rg As Range, ByVal n%, Alama)
For Each cel In Tot_rg.Columns(n).Cells
If cel = Alama Then
If cel.Interior.ColorIndex <> xlNone Then
s = s + 1
End If
End If
Next
End Sub