هذه لم افهمها (الحجم الساعي للأستاد)
لكن اتوقع عدد الحصص لكل صف
جرب هذا الكود
CODE
Option Explicit
Sub calclate()
Dim i%, RG As Range
Dim D As Object
Range("D17").Resize(, 10).ClearContents
Range("G18").Resize(, 7).ClearContents
Set RG = Range("C11:M15")
Set D = CreateObject("Scripting.Dictionary")
For i = 1 To RG.Cells.Count
If RG.Cells(i) <> 0 Then
D(RG.Cells(i).Value) = _
RG.Cells(i).Value & " : " & Application.CountIf(RG, RG.Cells(i)) & " حصة "
End If
Next
If D.Count Then
Range("D17").Resize(, D.Count) = D.keys
Range("G18").Resize(, D.Count) = D.Items
End If
End Sub
الملف مرفق