توزيع الطلاب على الفصول الدراسية

[ناصر سعيد]

بسم الله الرحمن الرحيم

هذا ملف به كود لتوزيع طلاب المدارس على الفصول ..

اكثر من رائع لسهولته وسرعته لانه يعمل بالمصفوفات

صاحب هذا الكود هو المبدع ياسر خليل ..

جزاه الله عنا كل خير

وبارك في كل واحد يخلص في عمله من اجل رحمة الله تعالى

 

 

تكوين فصول للمحترم ياســـــــــــــــــــر خليل.rar

Option Explicit

Sub ClassesListsUsingArrays()
'Author  : YasserKhalil
'Release : 30 - 06 - 2017
'------------------------
    Dim ws      As Worksheet
    Dim sh      As Worksheet
    Dim arr     As Variant
    Dim temp    As Variant
    Dim i       As Long
    Dim j       As Long
    Dim p       As Long
    Dim n       As Long
    Dim str     As String

'لمنع اهتزاز الشاشه
    Application.ScreenUpdating = False
    
    'متغير اسم ورقه المصدر
        Set ws = Sheets("بيانات الطلبة")
        
        'متغير اسم ورقه الهدف
        Set sh = Sheets("فصول")
        
    'مسح بيانات قائمه الفصل
        sh.Range("B8:F43,H8:L43").ClearContents
        
 'مدى صفوف قائمه الفصل وان تكون عدم مخفيه
        sh.Rows("8:43").Hidden = False
        
 'خليه القائمه المنسدله لاسماء الفصول
        str = sh.Range("L1").Value
        
        'مدى صفحة المصدر
        arr = ws.Range("A7:W" & ws.Range("A" & Rows.Count).End(xlUp).Row).Value
        
        ' يقوم بتعيين أبعاد المصفوفة (مصفوفة النتائج)
        'لتكون بنفس أبعاد مصفوفة البيانات من حيث عدد الصفوف وعدد الأعمدة
        ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    
    'مطابقة القيمة الموجودة في العمود رقم 22 (الذي يحتوي على رقم الفصل)
    'مع الشرط في الخلية L1
        For i = 1 To UBound(arr, 1)
        
        'متغير رقم عمود الفصل
            If arr(i, 22) = str Then
            
            'يزيد المتغير P بمقدار واحد
                p = p + 1
                
                
                For j = 1 To UBound(arr, 2)
                
                    temp(p, j) = arr(i, j)
                Next j
                
'هذا السطر الذي يتعامل مع القيمة كتاريخ
        temp(p, 7) = CLng(arr(i, 7))
                
 'تم وضع رقم تسلسلي للنتائج حسب قيمة المتغير
                temp(p, j - 1) = p
            End If
        Next i
        
        'عند حدوث خطأ انتقل الى الخطوه التاليه
        On Error Resume Next
        
        n = WorksheetFunction.Round(p / 2, 0)
        'الرقم 23 الخاص بالمسلسل
        'رقم عمود موجود بالمصفوفه
        'ولايوجد به بيانات
        sh.Range("B8").Resize(n, 5).Value = Application.Index(temp, Evaluate("row(1:" & n & ")"), Array(23, 5, 15, 7, 16))
        
        'الاسم / الديانه/ تاريخ الميلاد / القيد
        sh.Range("H8").Resize(n, 5).Value = Application.Index(temp, Evaluate("row(" & n + 1 & ":" & p + 1 & ")"), Array(23, 5, 15, 7, 16))
    
        For i = 43 To 8 Step -1
            If sh.Cells(i, 2).Value = "" Then sh.Rows(i & ":43").Hidden = True
        Next i
        ' اعاده الشاشه كما كانت
    Application.ScreenUpdating = True
End Sub

هذا هو تحفة الاكواد للنابغه ياسر خليل

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

بارك الله فيك أخي العزيز ناصر سعيد وجعله الله في ميزان حسناتك يوم القيامة

تقبل وافر تقديري واحترامي

[EL_Kashef]

الملف رائع

والكود أروع

بس عندى ملحوظة بسيطة

الملف ده ينفع مع أى مرحلة

ابتدائى - اعدادى - ثانوى

بس فى المرحلة الاعدادية والثانوية

مينفعش نحط تواريخ الميلاد

يعنى مثلا انا مدرستى اعدادى مشتركة

لو حطينا تاريخ الميلاد

يبقى كل يوم الاولاد هيعملوا حفلات اعياد ميلاد للبنات

ده غير الجوابات والتهنئة

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

بس ده الواقع

فلو سمحت ممكن نشيل تاريخ الميلاد ونخلى مكانه النوع ذكر - أنثى

ولو سمحت يكون الترتيب يبدأ بالبنات أولا ثم الأولاد

لأن ده النظام اللى ماشى عندنا

وياريت يكون بتنسيق 2003

عذرا للإطالة

 

تم تعديل يوليو 2, 2017 بواسطه EL_Kashef

[ناصر سعيد]

خطوط ولا اروع هديه طيبه ان شاء الله

ستجعل صوره القائمه غايه في الروعه

خط.rar

==========

رابط لخطوط غايه في الجمال والروعه

https://up.top4top.net/downloadf-3206k2ma1-rar.html

[ناصر سعيد]

جزاك الله كل خير ايها الاستاذ المحترم يا سر خليل

وبعد :

اخي السائل الكريم

الكود من اسهل الاكواد وينفع لاي مرحله تريدها وينفع تغير ماتشاء من اسماء الاعمدة

اما بالنسبه لطلبك

, Array(23, 5, 15, 7, 16))

ابحث عن هذا الجزء ستجده مرتين

غير الرقم 7 بالرقم 6

وشكرا

مامعنى ذلك ؟

اننا يحثنا في صفحة بيانات المصدر

عن رقم العمود المطلوب

ادراجه

في القائمه

ووضعناه في مكانه في الكود

[ناصر سعيد]

=*=*=*=*=*=*=*=

وبخصوص طلبك البنات اولا 

ادعو الله ان تكون ايجابيا في مدرستك وتجعل الاولاد اولا .. وان لم تتمكن الان فعندما تواتيك الفرصه لاتنسى ذلك

ساحضر لك كودا للابجده  ان شاء الله رب العالمين

 

 

[ناصر سعيد]

Sub Sort_Male()
    Dim lr As Long
    lr = Range("E" & Rows.Count).End(xlUp).Row
    Range("E7:Q" & lr).Sort Key1:=Range("F7:F" & lr), _
    Order1:=2, Header:=xlNo
End Sub

ضع هذا الكود في موديول واعمل له ..  زر بصفحه بيانات المصدر

لاتقلق هذا فرز ليأتي بالذكور اولا

واذا اردت ان تجعله يأتي بالبنات اولا

فما عليك الا ان تغير الرقم 2 الموجود في الكود وتجعله الرقم  1

[EL_Kashef]

ولا أروع

جزاك الله خيرا

[ناصر سعيد]

كود طباعه مطاط رائع

جزى الله من وضعه بكل خير وحفظه الله

Sub طباعة_فصل()
Dim LatR As Long
LatR = Range("C:C").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ActiveSheet
    .PageSetup.PrintArea = "A3:M" & LatR
    .PrintOut
End With
End Sub

لطباعه صفحة قائمه الفصل التي تختلف في عدد صفوفها من فصل لاخر

[ناصر سعيد]

 

    Sub SortData()
    Dim LR As Long
    LR = Range("B" & Rows.Count).End(xlUp).Row
    'مدى الفرز .. ثم معيار الفرز الاول
    'ثم معيار الفرز التاني
    Range("B9:K" & LR).Sort Key1:=Range("E9:E" & LR), Order1:=2, Key2:=Range("B9:B" & LR), Order2:=1, Header:=xlNo
    
End Sub

لفرز البنون والبنات ثم فرز البنون هجائيا وفرز البنات هجائيا

[ناصر سعيد]

 

===============

 

[ناصر سعيد]

 

[ناصر سعيد]

Sub SortData()

    Dim lr As Long

    lr = Range("E" & Rows.Count).End(xlUp).Row

    For Each Cell In ActiveSheet.Range("E7:E" & lr)

        Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)

    Next

    Range("B7:S" & lr).Sort Key1:=Range("F7:F" & lr), Order1:=2, Key2:=Range("E7:E" & lr), Order2:=1, Header:=xlNo

End Sub

كود للفرز بمعيارين

ولكن به اضافه مفيده

وهي ازاله المسافات من بين الاسماء

مما تعطي فرزا دقيقا

للمحترم الغالي ياسر العربي