خطأ في كود تم انشائه من قبل الذكاء الاصطناعي

[alsihran]

السلام عليكم 

هذا الكود تم عمله عن طريق شات جي بي تي 

وهو يقوم بتوزيع طلاب على مدرسين مرتين بشرط عدم تكرار نفس الطالب مع المدرس في المرة الثانية 

وعدم وضع الطالب ونفس المدرس من نفس المجموعة 

Option Compare Database
Option Explicit

Dim assignedTeachers() As Variant ' Global array to track assigned teachers

Sub DistributeStudentsToTeachers(callNumber As Integer)
    Dim db As DAO.Database
    Dim rstTeachers As DAO.Recordset
    Dim rstStudents As DAO.Recordset
    Dim rstLessons As DAO.Recordset
    Dim teacherCount As Integer
    Dim studentCount As Integer
    Dim teacherArray() As Variant
    Dim studentArray() As Variant
    Dim i As Integer
    Dim j As Integer
    Dim assigned As Boolean
    Dim minTeacherIndex As Integer
    Dim tempID As Variant
    Dim tempGroup As Variant
    Dim tempTimeEmp As Variant
    
    Set db = CurrentDb
    
    ' Open Teachers and Students tables
    Set rstTeachers = db.OpenRecordset("SELECT * FROM Tbl_Teachers")
    Set rstStudents = db.OpenRecordset("SELECT * FROM Tbl_Students")
    
    ' Count Teachers
    rstTeachers.MoveLast
    rstTeachers.MoveFirst
    teacherCount = rstTeachers.RecordCount
    
    ' Count Students
    rstStudents.MoveLast
    rstStudents.MoveFirst
    studentCount = rstStudents.RecordCount
    
    ' Verify there are Teachers and Students
    If teacherCount = 0 Or studentCount = 0 Then
        MsgBox "There are no teachers or students in the tables.", vbExclamation
        Exit Sub
    End If
    
    ' Store Teachers data in an array
    ReDim teacherArray(1 To teacherCount, 1 To 2) ' TeachersID, TeachersGroup
    i = 1
    rstTeachers.MoveFirst
    Do Until rstTeachers.EOF
        teacherArray(i, 1) = rstTeachers!TeachersID
        teacherArray(i, 2) = rstTeachers!TeachersGroup
        i = i + 1
        rstTeachers.MoveNext
    Loop
    
    ' Store Students data in an array
    ReDim studentArray(1 To studentCount, 1 To 3) ' StudentsID, StudentsGroup, TimeEmp
    i = 1
    rstStudents.MoveFirst
    Do Until rstStudents.EOF
        studentArray(i, 1) = rstStudents!StudentsID
        studentArray(i, 2) = rstStudents!StudentsGroup
        studentArray(i, 3) = rstStudents!TimeEmp
        i = i + 1
        rstStudents.MoveNext
    Loop
    
    ' Shuffle student array randomly
    Randomize
    For i = studentCount To 2 Step -1
        j = Int((i - 1 + 1) * Rnd + 1)
        tempID = studentArray(i, 1)
        tempGroup = studentArray(i, 2)
        tempTimeEmp = studentArray(i, 3)
        studentArray(i, 1) = studentArray(j, 1)
        studentArray(i, 2) = studentArray(j, 2)
        studentArray(i, 3) = studentArray(j, 3)
        studentArray(j, 1) = tempID
        studentArray(j, 2) = tempGroup
        studentArray(j, 3) = tempTimeEmp
    Next i
    
    ' Open Lessons table for adding records
    Set rstLessons = db.OpenRecordset("Tbl_Lessons", dbOpenDynaset)
    
    ' Distribute students to teachers avoiding previous teacher
    For i = 1 To studentCount
        assigned = False
        
        ' Find available teachers (different group) excluding previously assigned teachers
        For j = 1 To teacherCount
            If studentArray(i, 2) <> teacherArray(j, 2) And Not IsTeacherAssigned(studentArray(i, 1), teacherArray(j, 1), callNumber) Then
                ' Assign the student to this teacher
                rstLessons.AddNew
                rstLessons!TeacherID = teacherArray(j, 1)
                rstLessons!StudentID = studentArray(i, 1)
                rstLessons!DateLessons = Date
                rstLessons!Call_Time = GenerateRandomTime(CInt(studentArray(i, 3)))
                rstLessons!Call_Number = callNumber
                rstLessons.Update
                
                ' Update assigned teachers list for this student and call number
                UpdateAssignedTeachers studentArray(i, 1), teacherArray(j, 1), callNumber
                
                assigned = True
                Exit For
            End If
        Next j
        
        ' If no suitable teacher found
        If Not assigned Then
            MsgBox "Cannot assign student " & studentArray(i, 1) & " to any available teacher due to group match or previous assignment.", vbExclamation
        End If
    Next i
    
    ' Close all Recordsets
    rstTeachers.Close
    rstStudents.Close
    rstLessons.Close
    
    Set rstTeachers = Nothing
    Set rstStudents = Nothing
    Set rstLessons = Nothing
    Set db = Nothing
    
    MsgBox "Students have been successfully distributed to teachers. Call_Number = " & callNumber
End Sub

' Function to generate random time based on TimeEmp value
Function GenerateRandomTime(timeEmp As Integer) As Date
    Dim randomTime As Date
    
    Select Case timeEmp
        Case 0
            randomTime = #12:00:00 AM#
        Case 1
            randomTime = TimeValue("08:00 AM") + Rnd * (TimeValue("02:00 PM") - TimeValue("08:00 AM"))
        Case 2
            randomTime = TimeValue("08:00 AM") + Rnd * (TimeValue("04:00 PM") - TimeValue("08:00 AM"))
        Case 3
            randomTime = TimeValue("09:00 AM") + Rnd * (TimeValue("05:00 PM") - TimeValue("09:00 AM"))
        Case 4
            randomTime = TimeValue("11:00 AM") + Rnd * (TimeValue("05:00 PM") - TimeValue("11:00 AM"))
        Case Else
            randomTime = #12:00:00 AM#
    End Select
    
    GenerateRandomTime = randomTime
End Function

' Function to check if a teacher is already assigned to a student in a given call number
Function IsTeacherAssigned(studentID As Integer, teacherID As Integer, callNumber As Integer) As Boolean
    Dim i As Integer
    
    For i = LBound(assignedTeachers) To UBound(assignedTeachers)
        If assignedTeachers(i, 1) = studentID And assignedTeachers(i, 2) = teacherID And assignedTeachers(i, 3) = callNumber Then
            IsTeacherAssigned = True
            Exit Function
        End If
    Next i
    
    IsTeacherAssigned = False
End Function

' Procedure to update assigned teachers for a student in a specific call number
Sub UpdateAssignedTeachers(studentID As Integer, teacherID As Integer, callNumber As Integer)
    Dim nextIndex As Integer
    
    ' Find the next available index in assignedTeachers array
    nextIndex = IIf(IsEmpty(assignedTeachers), 1, UBound(assignedTeachers) + 1)
    
    ' Resize the array to accommodate new entry
    ReDim Preserve assignedTeachers(1 To nextIndex, 1 To 3)
    
    ' Add the assignment to the array
    assignedTeachers(nextIndex, 1) = studentID
    assignedTeachers(nextIndex, 2) = teacherID
    assignedTeachers(nextIndex, 3) = callNumber
End Sub

Sub Main()
    ' Initialize assignedTeachers array
    Erase assignedTeachers
    
    ' Distribute students with Call_Number = 1
    DistributeStudentsToTeachers 1
    
    ' Distribute students with Call_Number = 2
    DistributeStudentsToTeachers 2
End Sub

ويظهر الخطأ في هذا الجزء الموضح بالصورة 

 

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

تم تعديل يونيو 20 بواسطه alsihran

[jjafferr]

وعليكم السلام 🙂

اما انا فلم افلح مع الذكاء الصناعي !!

ما ادري ، يمكن اسألتي صعبة 😁

 

الخطأ يقول:

اول قيمة في الدالة ، نوع المتغير studentID في الدالة IsTeacherAssigned هو Integer

اقتباس

Function IsTeacherAssigned(studentID As Integer

.

بينما بدلا عن تدخل قيمة Integer ، انت ادخلت قيمة من نوع:

اقتباس

Dim studentArray() As Variant

.

الخطأ في السطر:

اقتباس

If studentArray(i, 2) <> teacherArray(j, 2) And Not IsTeacherAssigned(studentArray(i, 1)

.

 

سهله 🙂

 

جعفر

[ابو جودي]

7 دقائق مضت, jjafferr said:

الذكاء الصناعي !!

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

[alsihran]

11 ساعات مضت, jjafferr said:

اما انا فلم افلح مع الذكاء الصناعي !!

ما ادري ، يمكن اسألتي صعبة

تجربتي معاه جيد نظراً لعدم المامي الكامل بالمتغيرات والمصفوفات 

هو لازم تكون دقيق جدا في طرح السؤال والطلب حاول تشرح له كل كلمة بالتفصيل 

وانت صاحب باع طويل في هذا المجال اعتقد انك لو تسامحت معاه راح تفهمه ويفهمك 😁

11 ساعات مضت, jjafferr said:

ول قيمة في الدالة ، نوع المتغير studentID في الدالة IsTeacherAssigned هو Integer

لمى اغير في تعريف المتغير الممر الى الدالة Variant يظهر خطأ اخر  

ولمى اعمل العكس ايضا يظهر خطأ اخر 😇

[jjafferr]

13 دقائق مضت, alsihran said:

لمى اغير في تعريف المتغير الممر الى الدالة Variant يظهر خطأ اخر  

ولمى اعمل العكس ايضا يظهر خطأ اخر 😇

اسهل طريقة هو الرجوع الى نفس المحادثة مع الذكاء الصناعي ، واخبره عن الخطأ اعلاه ، وسيقوم باعطائك حلول 🙂

صعوبة التدخل في تعديل كود ، هو معرفة فكرة المبرمج في عمل المتغيرات ، وتسلسل التطبيق كذلك.

 

اما اذا تريد مساعدة في عمل جديد ، فاطرح موضوع جديد ، بأمثلة من واقع برنامجك ، والشباب ما بيقصروا معاك ان شاء الله 🙂

 

جعفر

[alsihran]

10 دقائق مضت, jjafferr said:

اسهل طريقة هو الرجوع الى نفس المحادثة مع الذكاء الصناعي ، واخبره عن الخطأ اعلاه ، وسيقوم باعطائك حلول 🙂

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

 

12 دقائق مضت, jjafferr said:

اما اذا تريد مساعدة في عمل جديد ، فاطرح موضوع جديد ، بأمثلة من واقع برنامجك ، والشباب ما بيقصروا معاك ان شاء الله 🙂

ما تقصر أنت والشباب شكرا لك استاذ جعفر 

[jjafferr]

اشوفك بدأت تعرف السر