برنامج المدرسة القرآنية(المجموع - الترتيب - التقدير - المنهج)

[أبو عبد الملك السوفي]

السلام عليكم

نواصل على بركة الله

المجموع في العمود R 

و R=E+F+G+I+K

 

Quran School V5.rar

[ياسر خليل أبو البراء]

تفضل أخي الكريم أبو عبد الملك

الملف التالي

تم إضافة السطر التالي

                .Cells(I, 18) = Application.WorksheetFunction.Sum(Range(.Cells(I, 5), .Cells(I, 7)), .Cells(I, 9), .Cells(I, 11))

تم تلوين عناوين الحقول التي يتم إدخالها بشكل يدوي للتمييز

Quran School V5.rar

[أبو عبد الملك السوفي]

ممتاز استاذنا ابا البراء

الآن نقطة الترتيب في العمودS

حيث يتم مقارنة مجموع درجات الطالب بباقي المجاميع وتعطى له الرتبة المناسبة كما تفعل الدالة RANK

لكن عند تعادل مجموعين يقدم الكود الطالب الاقل عدد غيابات (العمود H) فاذا تعادلا في الغياب أيضا يقدم اكثر نسبة حفظ (العمودJ) فاذا تعادلا يقدم الاعلى درجة في اختبار المراجعة(العمودG) فاذا تعادلا يقدم الاعلى درجة في اختبار الحفظ(العمودF)فاذا تعادلا يضع لهما نفس الرتبة

 

Quran School V5.rar

[ياسر خليل أبو البراء]

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

صوب لي ما قلت حتى نستطيع أن نبني الحل بشكل سليم ..

ويا ريت أمثلة كثيرة تشمل كل ما قلت حتى يكون الحل شاملاً ,,أي قم بالتطبيق على 10 طلاب مثلاُ واجعل المجموع متساوي في معظمهم ثم حاول تساوي عدد أيام الغياب وهكذا حتى نصل للحل بشكل شامل لكل الشروط

الموضوع محتاج شوية وقت .. إلا إذا أسعفنا أحد الأخوة الكرام بتقديم الحل المناسب لأني لست خبيراً في التعامل مع هذا النوع من المشكلات

[أبو عبد الملك السوفي]

السلام عليكم

جمعة مباركة ان شاء الله استاذ ياسر

استاذي لنحل هذا المشكل ولنطبق دالة  RANK البسيطة

ولا يهم ان ان تساوت الرتب

لان هنااك ماهو اهم من هذا بكثير

فقد كنت اضن ان ذالك سهل

ولنترك تطبيق تلك الشروط لفرصة اخرى

تم تعديل يونيو 5, 2015 بواسطه أبو عبد الملك السوفي

[ياسر خليل أبو البراء]

أخي الحبيب أبو عبد الملك

تم عمل المطلوب فيما يخص النقطة التي أشرت إليها بخصوص الترتيب في المشاركة رقم 3 ولم أفوتها كما طلبت

قمت بطرح موضوع في منتدى أجنبي والحمد لله وفقت في الوصول لحل رغم أن الموضوع بدا لي في منتهى الصعوبة .. ولكن بفضل الله تم بخير

إليك الملف المرفق وقم بتجربة الملف وشوف الرتب ..حاول تشوف النتائج وتقارن اللي قلته بالنتائج وغير في الدرجات وجرب تاني وخلي الغيابات واحدة وجرب وهكذا إلى أن يطمئن قلبك أن الأمور سارت كما أردت

Sub RankMultipleColumns()
    Dim A, I As Long, N As Long, Temp As String
    With Range("F2", Range("F" & Rows.Count).End(xlUp)).Resize(, 14)
        A = .Value
        ReDim Preserve A(1 To UBound(A, 1), 1 To 15)
        For I = 1 To UBound(A, 1)
            A(I, 15) = I
            A(I, 14) = Format$(A(I, 13), String(10, "0")) & 10000000 - A(I, 3) & _
                    Format$(A(I, 5), String(10, "0")) & Format$(A(I, 2), _
                    String(10, "0")) & Format$(A(I, 1), String(10, "0"))
        Next
        VSortM A, 1, UBound(A, 1), 14, 0
        For I = 1 To UBound(A, 1)
            If Temp <> A(I, 14) Then
                N = N + 1: Temp = A(I, 14)
            End If
            A(I, 14) = N
        Next
        VSortM A, 1, UBound(A, 1), 15, 1
        .Columns(14).Value = Application.Index(A, 0, 14)
    End With
End Sub

Private Sub VSortM(Ary, LB, UB, Ref, Optional Ord As Boolean = 1)
    Dim M As Variant, I As Long, II As Long, III As Long, Temp
    I = UB: II = LB
    M = Ary(Int((LB + UB) / 2), Ref)
    Do While II <= I
        If Ord Then
            Do While Ary(II, Ref) < M: II = II + 1: Loop
        Else
            Do While Ary(II, Ref) > M: II = II + 1: Loop
        End If
        If Ord Then
            Do While Ary(I, Ref) > M: I = I - 1: Loop
        Else
            Do While Ary(I, Ref) < M: I = I - 1: Loop
        End If
        If II <= I Then
            For III = LBound(Ary, 2) To UBound(Ary, 2)
                Temp = Ary(II, III): Ary(II, III) = Ary(I, III): Ary(I, III) = Temp
            Next
            II = II + 1: I = I - 1
         End If
    Loop
    If LB < I Then VSortM Ary, LB, I, Ref, Ord
    If II < UB Then VSortM Ary, II, UB, Ref, Ord
End Sub

تقبل تحياتي

Quran School V6.rar

[أبو عبد الملك السوفي]

السلام عليكم

كيف حال اساتذنا الكبير ابا البراء

آسف جدا عن التاخر في الرد فقد كانت النت مقطوعة

ماشاء الله تبارك الرحمان كل شيئ تمام

والله انا اتعبك كثيرا معي استاذ ياسر

اسال الله ان يكون هذا البرنامج صدقة جارية الى يوم القيامة ان شاء الله

ننتقل علىلا بركة الله الى نقطة التقدير

في العمود T بالعتماد على مجموع الدرجات في العمودR

والتقدير يكون كالتالي:

اذاكان المجموع من 98 الى 100 يكتب العبارة التالية : ناجح بتقدير ممتاز جدا

اذاكان المجموع من 90الى 97يكتب العبارة التالية : ناجح بتقدير ممتاز

اذاكان المجموع من 80الى 89يكتب العبارة التالية : ناجح بتقدير جيد جدا

اذاكان المجموع من 70الى 79يكتب العبارة التالية : ناجح بتقدير جدا

اذاكان المجموع من 60الى 69يكتب العبارة التالية : ناجح بتقديرحسن

اذاكان المجموع من 50الى 59 العبارة التالية : راسب بتقدير ضعيف

اذاكان المجموع من 40الى 49يكتب العبارة التالية : راسب بتقدير ضعيف جدا

اذاكان المجموع من 30الى 39يكتب العبارة التالية : راسب بتقدير توبيخ

اذاكان المجموع من 0الى 29يكتب العبارة التالية : راسب بتقدير إنذار

 

Quran School V6.rar

[ياسر خليل أبو البراء]

أخي الكريم أبو عبد الملك

إليك الدالة التالية وهي مشروحة في موضوع افتح الباب وكل كباب في صفحة المنتدى الرئيسية

Function Level(Mark As Variant) As String
    Select Case Mark
        Case ""
            Level = ""
        Case 0 To 29
            Level = "راسب بتقدير إنذار"
        Case 30 To 39
            Level = "راسب بتقدير توبيخ"
        Case 40 To 49
            Level = "راسب بتقدير ضعيف جداً"
        Case 50 To 59
            Level = "راسب بتقدير ضعيف"
        Case 60 To 69
            Level = "ناجح بتقدير حسن"
        Case 70 To 79
            Level = "ناجح بتقدير جيد"
        Case 80 To 89
            Level = "ناجح بتقدير جيد جداً"
        Case 90 To 97
            Level = "ناجح بتقدير ممتاز"
        Case 98 To 100
            Level = "ناجح بتقدير ممتاز جداً"
        Case "غ"
            Level = "غ"
    End Select
End Function

بالنسبة لحجم الملف إلى الآن 107 كيلو بايت .. كم نسبة الإنجاز إلى الآن ؟؟

 

(كفاية كدا على الموضوع ده ... يرجى طرح موضوع جديد .. لن أقبل بأي طلبات جديدة في هذا الموضوع)

 

تقبل تحياتي

Quran School V7.rar

[أبو عبد الملك السوفي]

السلام عليكم

بوركت استاذ ياسر

متميز دائما

نسبة الانجاز لنقل انها 50%

ماتزال هنالك نقطتان نكملها في هاتاه الصفحة نكملها في موضوع آخر ان شاء الله