مطلوب ترقيم الطلاب

[Ahmed Sary]

لدي جدول به

اسم الطالب : stu_name

نوعه ذكر/أنثى : stu_sex

حالته : مستجد / باق :stu_case

الطلب الأول :

ترقيم الطلبة جميعهم بحيث البنين المستجدون أولاً ثم البنين الباقون ثم البنات المستجدات ثم البنات الباقيات

no_serial  وهذا الترقيم في حقل 

الطلب الثاني :

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

ملحوظة:

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

...................

والمثال المرفق به جدول موضح به الناتج المطلوب

لاحظ المجموعة رقم 23 بها طالبة واحدة لأن الطالبة التي تليها كانت في فئة مختلفة

 

 

Database0.mdb

تم تعديل يونيو 29, 2021 بواسطه Ahmed Sary

[د.كاف يار]

تفضل التعديل

لكي يبدء الترقيم من بدء من رقم 1 

يبجب ان يبدء الترقيم من رقم صفر 0

 

Database0.zip Database0.mdb

تم تعديل يونيو 29, 2021 بواسطه د.كاف يار

[د.كاف يار]

عفوا كان فيه خطأ في ترقيم المجموعات

اتفضل التعديل

كذلك الترقيم عدلته تقدر تخليه يبدء من رقم 1

 

Database0.mdb 2Database0.zip

[محمد أبوعبدالله]

السلام عليكم

بالاضافة الى ما تفضل به اخي الحبيب واستاذي @د.كاف يار وله جزيل الشكر

تفضل اخي الكريم

Option Compare Database
Option Explicit

Private Sub Command0_Click()

       CurrentDb.Execute "UPDATE Table1 SET no_group = Null"
       CurrentDb.Execute "UPDATE Table1 SET no_serial = Null"

       
       Dim mySQL As String
       Dim rst As Recordset, rs As Recordset
       Dim i As Integer, k  As Integer, L   As Integer

        
1 On Error GoTo 2
        mySQL = "Select * From Table1 ORDER BY stu_case , stu_sex "
'        Debug.Print mySQL

        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst

            For i = 1 To rst.RecordCount
                rst.Edit
                rst!no_serial = i
                rst.Update
                rst.MoveNext
            Next
            rst.Close: Set rst = Nothing


2 On Error GoTo Err
        mySQL = "Select * From Table1 WHERE stu_case = 1 ORDER BY no_serial "
'        Debug.Print mySQL

        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst
        
            For i = 1 To rst.RecordCount
                For k = 1 To 6
                    rst.Edit
                    rst!no_group = i
                    rst.Update
                    rst.MoveNext
                Next
            Next
            rst.Close: Set rst = Nothing
            
            Call randx
Err:
            Call randx
End Sub

Sub randx()
       Dim mySQL As String
       Dim rst As Recordset, rs As Recordset
       Dim i As Integer, k  As Integer, L   As Integer
       
3 On Error GoTo Err
        mySQL = "Select * From Table1 WHERE stu_case = 2 ORDER BY no_serial "
'        Debug.Print mySQL

        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst

            L = Nz(DMax("[no_group]", "Table1"), 0) + 1
            For i = L To rst.RecordCount
                For k = 1 To 6
                    rst.Edit
                    rst!no_group = i
                    rst.Update
                    rst.MoveNext
                Next
            Next
            rst.Close: Set rst = Nothing
            
            MsgBox "Done", vbInformation, "Officena"

Err:

End Sub

Database03.rar

تحياتي

[د.كاف يار]

14 دقائق مضت, محمد أبوعبدالله said:

السلام عليكم

بالاضافة الى ما تفضل به اخي الحبيب واستاذي @د.كاف يار وله جزيل الشكر

تفضل اخي الكريم

Option Compare Database
Option Explicit

Private Sub Command0_Click()

       CurrentDb.Execute "UPDATE Table1 SET no_group = Null"
       CurrentDb.Execute "UPDATE Table1 SET no_serial = Null"

       
       Dim mySQL As String
       Dim rst As Recordset, rs As Recordset
       Dim i As Integer, k  As Integer, L   As Integer

        
1 On Error GoTo 2
        mySQL = "Select * From Table1 ORDER BY stu_case , stu_sex "
'        Debug.Print mySQL

        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst

            For i = 1 To rst.RecordCount
                rst.Edit
                rst!no_serial = i
                rst.Update
                rst.MoveNext
            Next
            rst.Close: Set rst = Nothing


2 On Error GoTo Err
        mySQL = "Select * From Table1 WHERE stu_case = 1 ORDER BY no_serial "
'        Debug.Print mySQL

        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst
        
            For i = 1 To rst.RecordCount
                For k = 1 To 6
                    rst.Edit
                    rst!no_group = i
                    rst.Update
                    rst.MoveNext
                Next
            Next
            rst.Close: Set rst = Nothing
            
            Call randx
Err:
            Call randx
End Sub

Sub randx()
       Dim mySQL As String
       Dim rst As Recordset, rs As Recordset
       Dim i As Integer, k  As Integer, L   As Integer
       
3 On Error GoTo Err
        mySQL = "Select * From Table1 WHERE stu_case = 2 ORDER BY no_serial "
'        Debug.Print mySQL

        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst

            L = Nz(DMax("[no_group]", "Table1"), 0) + 1
            For i = L To rst.RecordCount
                For k = 1 To 6
                    rst.Edit
                    rst!no_group = i
                    rst.Update
                    rst.MoveNext
                Next
            Next
            rst.Close: Set rst = Nothing
            
            MsgBox "Done", vbInformation, "Officena"

Err:

End Sub

Database03.rar 26.83 kB · 0 downloads

تحياتي

ماشاء الله لا قوة الا بالله 

فعلا الابداع لا يعرف الحدود 

فكرة احترافيه بكل ما تعنيه الكلمة

[محمد أبوعبدالله]

11 دقائق مضت, د.كاف يار said:

ماشاء الله لا قوة الا بالله 

حبيبي الغالي ربنا يزيدك ويبارك فيك

دمت لاخيك

تحياتي

[Ahmed Sary]

كل الشكر للاساتذة الكرام د.كاف يار ،  محمد أبوعبدالله

حلول رائعة