مساعدة في توزيع الطلاب

[رندة ابراهيم]

اريد توزيع الطلاب علي 26 قاعة  بالتساوي حسب معيار اما كل 5 طلاب ذكور و 5 طلاب انات في قاعة ..علما بان بعض الطلاب تم توزيعهم بشكل يدوي قد ينقص او يزيد عن المعيار

المصنف2.xlsx

[Foksh]

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

  

5 دقائق مضت, رندة ابراهيم said:

اما كل 5 طلاب ذكور و 5 طلاب انات في قاعة

هذا يعني انه يمكن ان يكون المعيار مختلفاً !!!!

طيب ، أمامك حلين اثنين في الوقت الحالي ..

الأول من خلال معادلات مع الإستعانة بخلية ( عمود مساعد ) . وسيكون الحل كالآتي :-

• سنجعل المعايير متغيره بحيث يتم ادخال عدد الذكور والإناث وعدد القاعات في الخلايا ( i5 , j5 , h5 )
  
• في الخلية المساعدة ولنفترض E2 ، نستعمل هذه المعادلة :-

  =IF(D2="M", COUNTIF($D$2:D2,"M"), COUNTIF($D$2:D2,"F"))

  طبعاً ، وسنسحب المعادلة الى آآآخر خلية للتنفيذ عليها . ولا مشكلة لو تم اخفائها على سبيل المثال .

• الآن في العمود C والخلية C2 نستخدم هذه المعادلة :-
   

  =IF(D2="M", "قاعة " & CEILING(E2/$I$5,1), "قاعة " & CEILING(E2/$J$5,1))

   

الثاني من خلال الماكرو التالي :-

Sub DistributeStudentsToRooms()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim totalRooms As Integer, malesPerRoom As Integer, femalesPerRoom As Integer
    Dim maleCount As Integer, femaleCount As Integer
    Dim roomAssignment As Integer
    Dim roomCounters() As Integer
    Dim gender As String
    
    
    Set ws = ThisWorkbook.Sheets("ورقة1")
    
    totalRooms = ws.Range("H5").Value
    malesPerRoom = ws.Range("I5").Value
    femalesPerRoom = ws.Range("J5").Value
    
    ReDim roomCounters(1 To totalRooms, 1 To 2)
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ws.Range("C2:C" & lastRow).ClearContents
    
    For i = 2 To lastRow
        gender = ws.Cells(i, "D").Value
        
        For roomAssignment = 1 To totalRooms
            If gender = "M" Then
                If roomCounters(roomAssignment, 1) < malesPerRoom Then
                    roomCounters(roomAssignment, 1) = roomCounters(roomAssignment, 1) + 1
                    Exit For
                End If
            Else
                If roomCounters(roomAssignment, 2) < femalesPerRoom Then
                    roomCounters(roomAssignment, 2) = roomCounters(roomAssignment, 2) + 1
                    Exit For
                End If
            End If
            
            If roomAssignment = totalRooms Then roomAssignment = 0
        Next roomAssignment
        
        ws.Cells(i, "C").Value = "قاعة " & roomAssignment
    Next i
    
    MsgBox "تم توزيع الطلاب على القاعات بنجاح", vbInformation + vbMsgBoxRight, ""
End Sub

 

وهذا ملف مرفق للطريقتين :-

 

 

Desktop.zip