توزبع التلاميذ على الفصول عشوائى

[ابو غريب]

احوانى الاعزاء خبراء المنتدى ارجو منكم المساعده فى هذا الطلب اريد توزيع تلاميذ جدد على الفصول عدد التلاميذ 180تلميذ منهم بنون وبنات  وعدد الفصول 3 فصول المطلوب توزيع التلاميذ على الفصول بشكل متساوى بنون وبنات مرفق ملف موضح به المطلوب ولكم جزيل الشكر

توزيع التلاميذ.rar

[طارق محمود]

السلام عليكم

تفضل المرفق

توزيع التلاميذ2.rar

[أبو أنس80]

شي جميل جدا

لكن اريد نفس توزيع على اساس ابجدي و ليس عشوائي

شكرا

[ابو غريب]

شكرا يااستاذ /  طارق على هذا المجهود الرائع هذا الملف ينفع مدرسة مثل مدرستى بها ثلاث  فصول فى كل صف ولكن لو مدرسة بها اكثر من ذلك اربع او خمس فصول ما التغير الذى اقوم به  فى الكود حتى يتم التوزيع على اربع فصول او اكثر مع علم سيادتكم ان العدد الموجود لم يتم توزيعه بالكامل العدد الذى تم توزيعه 140 تلميذ فقط  وجملة التلاميذ 180 تلميذ

ولك جزيل الشكر اننى اشعر انى اثقلت عليك ولكن هذا من العشم وجعله الله لك فى ميزان حسناتك    شششششششششششششششششششششششششششششششششششششكرا

تم تعديل أغسطس 28, 2013 بواسطه ابوجادالله

[طارق محمود]

السلام عليكم

 

أخي الفاضل / shakhawan

لكن اريد نفس توزيع على اساس ابجدي و ليس عشوائي

 

 

تفضل المرفق

 

توزيع التلاميذ3.rar

[ابو غريب]

اخى الاستاذ طارق اشكرك على هذا المجهود الرائع ولاكن هذا الترتيب لايفيدنى فى عملى الترتيب العشوائى هو المطلوب اننى اعمل بمدرسة ويكون توزيع التلاميذ على الفصول بنون وبنات اى الفصل الواحد به بنون وبنات ارجو من سيادتكم توضيح لى كيف اتحكم فى زيادة عدد الفصول كما طلبت منكم فى المشاركة السابقه  ولسيادتكم جزيل الشكر

[طارق محمود]

السلام عليكم

 

أخي الفاضل / ابوجادالله

(1) لو مدرسة بها اكثر من ذلك اربع او خمس فصول

فما التغير الذى اقوم به  فى الكود حتى يتم التوزيع على اربع فصول او اكثر

(2) مع العلم ان العدد الموجود لم يتم توزيعه بالكامل العدد الذى تم توزيعه 140 تلميذ فقط  وجملة التلاميذ 180 تلميذ

 

 

 

سأبدأ بالنقطة الثانية

عندك حق ، وقد عدلت الكود كما يلي

Sub Rnd_3_Col()
Dim boy(999) As String, grl(999) As String, slct(999) As Integer
Application.ScreenUpdating = False
    
    ' Read data
    b = 0: g = 0
    LR = [B65536].End(xlUp).Row
    Range("D7:F" & LR).ClearContents
    For r = 7 To LR
        If Cells(r, 3) = "أ" Then
            g = g + 1: grl(g) = Cells(r, 2)
        ElseIf Cells(r, 3) = "ذ" Then
            b = b + 1: boy(b) = Cells(r, 2)
        End If
    Next r
    
    TN = b + g
    Randomize
    s = 0 ' s for selected
    For col = 4 To 5 ' Column D & E
        For i = 1 To TN / 3
10        x = Int(Rnd * TN) + 1
                For ch = 1 To s
                    If slct(ch) = x Then GoTo 10
                Next ch
            s = s + 1: slct(s) = x
            ready_row = Cells(999, col).End(xlUp).Row + 1
            If x > g Then x = x - g: dd = boy(x) Else dd = grl(x)
        Cells(ready_row, col).Value = dd
        Next i
    Next col
    
    ' Column F
        For i = 1 To TN
            For ch = 1 To s
                If slct(ch) = i Then GoTo 20
            Next ch
            ready_row = Cells(999, 6).End(xlUp).Row + 1
             If i > g Then x = i - g: dd = boy(x) Else dd = grl(i)
        Cells(ready_row, 6).Value = dd
20      Next i

Application.ScreenUpdating = True
End Sub

وبالمرفق ستجد أن هذه النقطة قد إنضبطت مهما كان عدد الطلبة والطالبات

 

 

اما النقطة الأولي التغيرات الذى تقوم به  فى الكود حتى يتم التوزيع على سبع فصول مثلا فيلزمك عدة تغيرات في الكود

(1) ستغير الرقم 3 إلي 7 في السطر          :    For i = 1 To TN / 3 ليكون  For i = 1 To TN / 7

(2) وتغير أرقام الأعمدة التي ستتلقي البيانات في السطر السابق له        

   For col = 4 To 5 ' Column D & E    ليكون  For col = 4 To 9 ' Column D to I

(3) وتغير رقم العمود الأخير لتلقي البيانات في الجزء الأخير من الكود

    ' Column F        For i = 1 To TN
            For ch = 1 To s
                If slct(ch) = i Then GoTo 20
            Next ch
            ready_row = Cells(999, 6).End(xlUp).Row + 1
             If i > g Then x = i - g: dd = boy(x) Else dd = grl(i)
        Cells(ready_row, 6).Value = dd
20      Next i

 

ليكون

    ' Column J
        For i = 1 To TN
            For ch = 1 To s
                If slct(ch) = i Then GoTo 20
            Next ch
            ready_row = Cells(999, 10).End(xlUp).Row + 1
             If i > g Then x = i - g: dd = boy(x) Else dd = grl(i)
        Cells(ready_row, 10).Value = dd
20      Next i

 

(4) وأخيرا ، تغير رقم المجال الذي يتم مسحه في بدايات الكود من

Range("D7:F" & LR).ClearContents

إلي

Range("D7:I" & LR).ClearContents

توزيع التلاميذ4.rar

[أم عبد الله]

أستاذنا الفاضل المهندس / طارق

 

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

 

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

[abomalak]

لو سمحت ممكن  تنزل ملف جاهز مكون من 4 فصول

[طارق محمود]

السلام عليكم

أخي الفاضل / ابوملك

الكود بعد التعديل (4 فصول)

Sub Rnd_3_Col()
Dim boy(999) As String, grl(999) As String, slct(999) As Integer
Application.ScreenUpdating = False
    
    ' Read data
    b = 0: g = 0
    LR = [B65536].End(xlUp).Row
    Range("D7:G" & LR).ClearContents
    For r = 7 To LR
        If Cells(r, 3) = "أ" Then
            g = g + 1: grl(g) = Cells(r, 2)
        ElseIf Cells(r, 3) = "ذ" Then
            b = b + 1: boy(b) = Cells(r, 2)
        End If
    Next r
    
    TN = b + g
    Randomize
    s = 0 ' s for selected
    For col = 4 To 6 ' Column D,E & F
        For i = 1 To TN / 4
10        x = Int(Rnd * TN) + 1
                For ch = 1 To s
                    If slct(ch) = x Then GoTo 10
                Next ch
            s = s + 1: slct(s) = x
            ready_row = Cells(999, col).End(xlUp).Row + 1
            If x > g Then x = x - g: dd = boy(x) Else dd = grl(x)
        Cells(ready_row, col).Value = dd
        Next i
    Next col
    
    ' Column G
        For i = 1 To TN
            For ch = 1 To s
                If slct(ch) = i Then GoTo 20
            Next ch
            ready_row = Cells(999, 7).End(xlUp).Row + 1
             If i > g Then x = i - g: dd = boy(x) Else dd = grl(i)
        Cells(ready_row, 7).Value = dd
20      Next i

Application.ScreenUpdating = True
End Sub

والملف مرفق بعد التعديل (4 فصول)

توزيع التلاميذ5.rar

[طارق محمود]

الأخت الفاضلة / أم عبد الله

جزاكي الله خيرا علي مرورك الطيب وكلماتك الرقيقة

[abomalak]

أ / طارق

جزاك الله خيرا وشكرا على اهتمامك

[عبد الحميد شقير]

التميز  دائماً لصيق بكم جزاكم الله كل الخير

[ابو غريب]

الف شكر يااخى طارق مع تمنياتى بالتوفيق الدائم ولا املك غير اننى أدعو لك الله "جزاك الله خيرا"

[طارق محمود]

إخواني وأحبائي (أبو ملك / عبد الحميد شقير / ابوجادالله)

جزاكم الله جميعا خير الجزاء

[ناصر سعيد]

الاسناذ ابو جاد الله

توريغ الطلاب على القصول له طريقه بكون بالعدل قدر الامكان

وهو التوزيع بالدرجات حتى لا بكون فصول قويه وفصول ضعيفه الطلاب

[ناصر سعيد]

الاستاذ طارق اشكرك على هذا المجهود الرائع

[ابو غريب]

استاذ نصر اشكرك على توجيهات سيادتكم  وكلامك صحيح ولكن  هذا بالنسبة للتعليم الاعدادى والتعليم الثانوى ولكن هذا الملف يستحدم فى الصف الاول الابتدائى التلاميذ المسجدين لهذ العام ولسيادتكم جزيل الشكر 

[أبو أنس80]

اشكرك يا استاذي يا اخي

طارق محمود