احصائية طلبة حسب النوع والقسم العلمي

[رسول هادي]

السلام عليكم

ارجو ان يكون الجميع بخير وصحة وسلامة 

في المرفق ملف اكسل يتضمن ورقتي عمل الاولى تحتوي على قائمة باسماء الطلبة مع بياناتهم وفي الورقة الثانية جدول يتضمن احصائية بالطلبة الموجودين في الورقة الاولى حسب القسم والنوع والصف اخذين بنظر الاعتبار امكانية اضافة او حذف الاسماء او تغيير النوع او القسم. شاكرين جهودكم 

موجودون 2020 اولية 13-4-2020.xlsx

[Ali Mohamed Ali]

وعليكم السلام-يمكنك استخدام هذه المعادلة

=COUNTIFS(الموجودون!$D:$D,B$2,الموجودون!$G:$G,B$1,الموجودون!$F:$F,$A3)

 

1.xlsx

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

لا ضرورة لرفع ملف من اكثر من 2000 صف

يكفي نموذج بسيط (في الملف المرفق حوالي 130 صف )فقط لمعايتة الماكرو

يمنكنك اضافة اي عدد من الصفوف في الورقة Toullab شرط عدم ترك خلايا فارغة في الصفوف حيث يعمل الفلتر ( الرابع  السادس  والسابع)

شخصياً لا افضّل تسمية الشيتات باللغة الغربية لصعوبة كتابة الكود ونقله

الكود

 

Option Explicit
Sub My_FILTER()
      Rem Created by Saliom Hasbaya on 14/4/2020
      With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
      End With
Dim T As Worksheet, S As Worksheet
Dim T_Table As Range, mr As Range, era As Range
Dim i%, lr%, x%, Homany%, k%, y%
Dim arr

Set T = Sheets("Toullab"): Set S = Sheets("Statics")
arr = Array("الاول", "الثاني", "الثالث", "الرابع")

 Set T_Table = T.Range("A1").CurrentRegion
 If T.AutoFilterMode Then T_Table.AutoFilter
 lr = S.Cells(Rows.Count, 1).End(3).Row
  With S.Range("C4:D" & lr - 1)
  .ClearContents
  .Offset(, 3).ClearContents
  .Offset(, 6).ClearContents
  .Offset(, 9).ClearContents
  End With
 y = 2
For k = 0 To 3
 For i = 4 To lr - 1
 '++++++++++++++++++++++++++++++++++++
  T_Table.AutoFilter 6, S.Cells(i, 1)
  T_Table.AutoFilter 7, arr(k)
  T_Table.AutoFilter 4, S.Cells(2, 3)
  
  Set mr = T_Table.SpecialCells(xlCellTypeVisible).Offset(1)
  For Each era In mr.Areas
   x = Application.CountA(era.Columns(7))
  If x Then
  Homany = Homany + era.Rows.Count
End If
Next
  S.Cells(i, 1).Offset(, y) = Homany - 1: Homany = 0
  '************************************************************
  T_Table.AutoFilter 4, S.Cells(2, 4)
  Set mr = T_Table.SpecialCells(xlCellTypeVisible).Offset(1)
  For Each era In mr.Areas
   x = Application.CountA(era.Columns(7))
  If x Then
    Homany = Homany + era.Rows.Count
  End If
Next
  S.Cells(i, 1).Offset(, y + 1) = Homany - 1: Homany = 0
  
  Next i
  y = y + 3
Next k
If T.AutoFilterMode Then T_Table.AutoFilter
      With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
      End With
Set T = Nothing: Set S = Nothing
Set T_Table = Nothing
Set mr = Nothing: Set era = Nothing
End Sub

الملف مرفق

OH_my_filter.xlsm

[رسول هادي]

شكرا جزيلا وبارك الله فيكم