محتاج شرح الكود لامكانيه التعديل عليه

[ehabaf2]

السلام عليكم السادة الافاضل

كنت محتاج شرح اسطر الكود لكي افهم طبيعة عمله و اتمكن من تعديل النطاق اللي بيعمل عليه ( الكود لاستخراج الطلبة الضعاف )

و لكم جزيل الشكر

 

 

Sub LastTest2()
'--------------------
كود استخراج الطلاب الضعاف

'--------------------
Dim i As Long, ws As Worksheet, Rng As Range
Dim C As Range, p As Integer, x
Dim Shp As Shape, Nam As String
Set ws = Sheets("الاول")
Application.ScreenUpdating = False
Range("ay5:az71") = ""
Set Shp = ws.Shapes(Application.Caller)
Nam = Shp.TextEffect.Text
ws.Range("KN1") = " ÇáØáÇÈ ÇáÖÚÇÝ ÇÞá ãä 65 % á" & Nam
p = 4
i = 5
Do While i <= 70
With ws
Select Case Nam
Case "شهر 10"
x = Array(214, 215, 216, 217, 218, 219, 220, 224, 228, 232, 236, 240, 244, 248)
Case "شهر 11"
x = Array(214, 215, 216, 217, 218, 219, 221, 225, 229, 233, 237, 241, 245, 249)
Case "شهر 12"
x = Array(214, 215, 216, 217, 218, 219, 222, 226, 230, 234, 238, 242, 246, 250)
Case Else
End Select
For j = LBound(x) To UBound(x)
Set Rng = .Cells(i, x(j))
For Each C In Rng
y = .Cells(4, x(j)) * 0.65
If .Cells(i, x(j)) < y Then
m = m + 1
If m > 1 Then GoTo 88:
p = p + 1
For a = 0 To 13
.Cells(p, a + 298) = .Cells(i, x(a))
.Cells(p, 298) = p - 4
Next
End If
Next
Next
End With
88:
m = 0
i = i + 1
Loop
End Sub

تم تعديل نوفمبر 19, 2023 بواسطه ehabaf2

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

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

اليك شرح الكود المطلوب ارجو ان اكون قد وفقت

Sub LastTest()
'--------------------
Dim i As Long, ws As Worksheet, Rng As Range
Dim C As Range, p As Integer, x
Dim Shp As Shape, Nam As String
Set ws = Sheets("Sheet2")
Application.ScreenUpdating = False
Range("AO5:BB100") = ""      '  مسح النطاق الذى سوف يتم ارسال بيانات التلاميذ الضعاف
Set Shp = ws.Shapes(Application.Caller)   ' تعريف الشكل حسب العنوان المكتوب عليه
Nam = Shp.TextEffect.Text   '  الاسم المكتوب على الشكل
ws.Range("AQ1") = " الطلاب الضعاف اقل من 65 % ل" & Nam   '  عبارة تكتب عقب الضغط على اى زر حسب الشهر
p = 4       ' لعد التلاميذ الضعاف بدلا من الصفر يعنى
i = 5  '  اول صف سوف يتم العمل عليه
Do While i <= 70    '  آخر صف سوف يتم العمل عليه حسب المرفق و يم تغييره بسهولة
With ws
Select Case Nam   '  الاعمدة التى سوف يتم العمل عليها حسب اسم الشهر المكتوب على الزر
Case "شهر 10"
x = Array(1, 2, 3, 4, 5, 6, 7, 11, 15, 19, 23, 27, 31, 35)
Case "شهر 11"
x = Array(1, 2, 3, 4, 5, 6, 8, 12, 16, 20, 24, 28, 32, 36)
Case "شهر 12"
x = Array(1, 2, 3, 4, 5, 6, 9, 13, 17, 21, 25, 29, 33, 37)
Case Else
End Select
For j = LBound(x) To UBound(x)   ' عدد الاعمدة المطلوبة للعمل عليها و تكون مصفوفة
Set Rng = .Cells(i, x(j))   ' التعريف بالنطاق و جعل كل صف على حدة كمصوفة مستقلة بذاتها
For Each C In Rng  '     كل خلية فى هذا النطاق
y = .Cells(4, x(j)) * 0.65  '  شرط النجاح
If .Cells(i, x(j)) < y Then   ' اذا كان الشرط غير متوافر
m = m + 1     '  عد مواد الرسوب اقل من 65%
If m > 1 Then GoTo 88:    '  تكفى مادة واحدة ليبدأ للعمل عليها
p = p + 1    '  العد
For a = 0 To 13   ' عدد الخلايا التى سيتم ترحيل البيانات اليها
.Cells(p, a + 41) = .Cells(i, x(a))   ' ترحيل البيانات
.Cells(p, 41) = p - 4  '  مسلسل للتلاميذ الضعاف
Next
End If
Next
Next
End With
88:
m = 0
i = i + 1
Loop
End Sub

 

[ehabaf2]

الف الف شكر لحضرتك استاذنا الفاضل ابراهيم الحداد 

بارك الله فى عمرك و زادك من فضله و علمه