ehabaf2 قام بنشر نوفمبر 19, 2023 مشاركة قام بنشر نوفمبر 19, 2023 (معدل) السلام عليكم السادة الافاضل كنت محتاج شرح اسطر الكود لكي افهم طبيعة عمله و اتمكن من تعديل النطاق اللي بيعمل عليه ( الكود لاستخراج الطلبة الضعاف ) و لكم جزيل الشكر 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 رابط هذا التعليق شارك More sharing options...
أفضل إجابة ابراهيم الحداد قام بنشر نوفمبر 19, 2023 أفضل إجابة مشاركة قام بنشر نوفمبر 19, 2023 السلام عليكم و رحمة الله اليك شرح الكود المطلوب ارجو ان اكون قد وفقت 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 5 رابط هذا التعليق شارك More sharing options...
ehabaf2 قام بنشر نوفمبر 19, 2023 الكاتب مشاركة قام بنشر نوفمبر 19, 2023 الف الف شكر لحضرتك استاذنا الفاضل ابراهيم الحداد بارك الله فى عمرك و زادك من فضله و علمه رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.