قوائم الفصول

[khairi ali]

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

أخواني الكرام في هذا المنتدى كيف حالكم جميعا

في الملف المرفق اريد التعديل على كود كل الفصول بحيث عند الضغط على الزر يقوم بجلب جميع الفصول بناء على الفصل - الشعبة - الجنس - العام الدراسي

ولكم مني فائق الاحترام

فصول2020.xlsm

[ابراهيم الحداد]

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

استخدم الكود التالى 

Sub ImpClass()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, LS As Long
Dim i As Long, p As Long
Dim Cls As String
Set ws = Sheets("arshef")
Set Sh = Sheets("ك.غ")
LR = ws.Range("B" & Rows.Count).End(3).Row
j = 2
Do While j <= 310
Cls = Sh.Range("G" & j).Text
For i = 5 To LR
If ws.Range("Q" & i).Text = Cls Then
p = p + 1
Sh.Range("C" & p + j + 2) = ws.Range("B" & i)
End If
Next
p = 0
j = j + 28
Loop
End Sub

 

[khairi ali]

مشكور جدا  وبارك الله فيك وأن شاء الله في ميزان حسناتك

لو سمحت شرح للكود

[khairi ali]

استاذي الفاضل ابراهيم لو سمحت هناك شرطان وهما النوع والشعبة لا يشتغل

 

تم تعديل ديسمبر 13, 2021 بواسطه khairi ali

[ابراهيم الحداد]

السلام عليكم ورخمة الله

تم التعديل

Sub ImpClass()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, LS As Long
Dim i As Long, p As Long
Dim Cls As String, Spld As String, Knd As String
Set ws = Sheets("arshef")
Set Sh = Sheets("ك.غ")
LR = ws.Range("B" & Rows.Count).End(3).Row
j = 2
Do While j <= 310
Sh.Range("C" & j + 3).Resize(25).ClearContents
Cls = Sh.Range("G" & j).Text
Spld = Sh.Range("K" & j).Text
Knd = Sh.Range("AF1").Text

For i = 5 To LR
If ws.Range("Q" & i).Text = Cls Then
If ws.Range("P" & i).Text = Spld Then
If ws.Range("L" & i).Text = Knd Then
p = p + 1
Sh.Range("C" & p + j + 2) = ws.Range("B" & i)
End If
End If
End If
Next
p = 0
j = j + 28
Loop
End Sub

 

[khairi ali]

زادك الله علما ان شاء الله في ميزان حسناتك