إجمالي مرات مشاهدة الصفحة

السبت، 12 نوفمبر 2016

توليد امتحان بشكل عشوائي من بنك أسئلة Generate Random Test Paper From Questions Bank

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


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

بفرض أن لديك في ورقة العمل Sheet2 مجموعة كبيرة من الأسئلة (بنك الأسئلة) ، والمطلوب هو توليد 10 أسئلة في كل مرة يتم تنفيذ الكود فيها ، وتظهر النتائج في ورقة العمل Sheet1

إليكم الكود المستخدم لهذه المهمة مع الشرح لأسطر الكود بالتفصيل

Sub Generate_Test()
    'الإعلان عن المتغيرات
    Dim i                   As Long
    Dim rowNum              As Long
    Dim qNum                As Long

    'إلغاء خاصية تحديث الشاشة لتسريع الكود
    Application.ScreenUpdating = False

    'تعيين قيمة للمتغير ليساوي عدد الأسئلة في ورقة بنك الأسئلة وهنا
    'استخدمنا دالة العد لتقوم بعد الخلايا في العمود الأول في ورقة الأسئلة
    qNum = Application.WorksheetFunction.CountA(Sheets("Sheet2").Columns(1))

    'بدء التعامل مع ورقة النتائج التي تريد توليد الأسئلة العشوائية بها
    With Sheets("Sheet1")

        'مسح محتويات النطاق الذي سيحتوي على النتائج
        .Range("A2:A10000").ClearContents

        'حلقة تكرارية من 1 إلى 10 ويمثل عدد الأسئلة المطلوب توليدها
        'إذا أردت أن تقوم بتوليد عدد أسئلة أكثر قم بتغيير الرقم 10
        For i = 1 To 10

'نقطة انتقال بحيث لو كان السؤال مكرر يرجع لتلك النقطة
Generate:
            'توليد رقم عشوائي بين 1 و أكبر عدد للأسئلة لاختيار صف عشوائي
            rowNum = Application.RoundUp(Rnd() * qNum, 0)

            'هذا الجزء للتأكد من أن السؤال غير مكرر حيث استخدمت دالة العد المشروط
            If Application.CountIf(.[A:A], Sheets("Sheet2").Cells(rowNum, "A")) = 0 Then

                'في حالة أن السؤال غير مكرر يتم جلب السؤال من ورقة الأسئلة
                .Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Sheets("Sheet2").Cells(rowNum, "A").Value
            Else

                'في حالة أن السؤال مكرر يتم الرجوع لنقطة الانتقال
                'لإعادة توليد رقم صف عشوائي جديد
                GoTo Generate

            'نهاية جملة الشرط
            End If

        'الانتقال للحلقة التالية أي للسؤال التالي
        Next i

    'نهاية التعامل مع ورقة العمل
    End With

    'إعادة تفعيل خاصية تحديث الشاشة
    Application.ScreenUpdating = True
End Sub


إعداد / ياسر خليل أبو البراء

هناك 10 تعليقات:

  1. ملف مهم جدا ومفيد واكثر من رائع
    جزاك الله كل خير اخي ابو البراء وجعله الله في ميزان حسناتك

    ردحذف
  2. مشكور على مرورك العطر أخي العزيز أسامة والحمد لله أن الموضوع مفيد لك
    جدو الغالي سلمت من كل سوء

    ردحذف
  3. يعجز اللسان عن التعبير وايصال التشكرات لك استاذ ياسر بارك الله فيك

    ردحذف
  4. بارك الله فيك أخي العزيز وجزاك الله خيراً .. تقبل تحياتي

    ردحذف
  5. رائع من يومك يا كبير

    ردحذف
  6. الأروع دائماً هو مرورك الندي يا صقر الإكسيل .. طالت غيبتك عنا واشتقنا لرؤية أعمالك

    ردحذف
  7. يمكنك تكملة البرنامج لكى يختار الطالب بعشوائية ويتم التصحيح آلى الفكرة بسيطة

    ردحذف
  8. يمكنك تكملة البرنامج لكى يختار الطالب بعشوائية ويتم التصحيح آلى الفكرة بسيطة

    ردحذف
  9. أزال المؤلف هذا التعليق.

    ردحذف