مطلوب تعديل على كود ترقيم

[Ahmed Sary]

السلام عليكم

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

ولكن أود التعديل واضافة شرط جديد وأرجو من الزملاء المساعدة. وباختصار :

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

. وكل حالة قد يوجد بها ذكور إو إناث

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

داخل كل فصل يتم ترقيم الناجحون أولً ذكور  مرتبون حسب الاسم ثم الناجحات إناث أيضا مرتبون حسب الاسم ثم الراسبون ذكور مرتبون حسب الاسم ثم الراسبون إناث مرتبة حسب الاسم

جميع من بالفصل يتم تقسيمه على مجموعات لا تزيد عن ستة طلاب 

يتم تسلسل الطلاب على مستوى الفصل ككل   في حقل التسلسل SN

..... 

 عندما تبدأ حالة الرسوب للطلاب داخل الفصل تبدأ مجموعة جديدة 

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

 

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

 

ترقيم1.mdb

[د.كاف يار]

تفضل هذه الطريقة

Dim db              As DAO.Database
Dim rs              As DAO.Recordset
'============== الطلاب =================
Dim MaleTrue        As Integer  'الطالاب الناجحون
Dim MaleFalse       As Integer 'الطلاب الغير ناجخون
'============== الطالبات =================
Dim FemaleTrue      As Integer  'الطالبات الناجحات
Dim FemaleFalse     As Integer 'الطالبات الغير ناجحات
    
Set rs = CurrentDb.OpenRecordset("Table1") ' جدول البيانات
    
    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        While (Not rs.EOF)
        rs.Edit
         If rs.Fields("نوع الطالب") = "ذكر" And rs.Fields("نتيجة الطالب") = "ناجح" Then
                MaleTrue = MaleTrue + 1				
                rs![رقم الطالب] = MaleTrue
         ElseIf rs.Fields("نوع الطالب") = "ذكر" And rs.Fields("نتيجة الطالب") = "راسب" Then
                MaleFalse = MaleFalse + 1
                rs.[رقم الطالب] = MaleFalse
         ElseIf rs.Fields("نوع الطالب") = "انثى" And rs.Fields("نتيجة الطالب") = "ناجح" Then
                FemaleTrue = FemaleTrue + 1
                rs![رقم الطالب] = FemaleTrue
         ElseIf rs.Fields("نوع الطالب") = "انثى" And rs.Fields("نتيجة الطالب") = "ناجح" Then
                FemaleFalse = FemaleFalse + 1
                rs![رقم الطالب] = FemaleFalse
        End If
		rs.Update         
            rs.MoveNext
        Wend
    End If
    rs.Close
    Set rs = Nothing

 

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

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

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

وحسب ما فهمت من الشرح

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

Option Compare Database
Option Explicit

Private Sub Command0_Click()
       CurrentDb.Execute "UPDATE Table1 SET group_no = Null"
       CurrentDb.Execute "UPDATE Table1 SET SN = 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,stu_name "
'        Debug.Print mySQL
        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst

            For i = 1 To rst.RecordCount
                rst.Edit
                rst!SN = 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   stu_case, stu_sex,stu_name "
'        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!group_no = 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 SN "
'        Debug.Print mySQL

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

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

            MsgBox "Done", vbInformation, "Officena"

Err:

End Sub

 

ترقيم1.mdb

تحياتي

[Ahmed Sary]

شكرا على مرورك د.كاف يار . أنا حاولت تطبيق الكود وتغيير اسماء الحقول إلى نفس حقول الجدول ولكن لم أستطع 

Just now, محمد أبوعبدالله said:

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

وحسب ما فهمت من الشرح

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

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

  يبدأ ترقيم المجموعة وترقيم التسلسل كلاهما من رقم 1

 كذلك عندما يبدأ الراسبون في نفس الفصل تبدأ مجموعة جديدة داخل الفصل  على نفس تسلسل المجموعات بالفصل

قارن بين الاستعلام المبنى على تنفيذ كود معاليك ، وبين الجدول المحدث ستصلك فكرتي أكثر.

ترقيم2.mdb

[Ahmed Sary]

up

[Ahmed Sary]

up

[Ahmed Sary]

UP

[د.كاف يار]

تفضل التعديل

 

ترقيم.mdb

[Ahmed Sary]

شكرا جزيلا يا دكتور . جاري التجربة