XL 2016 Créer plusieurs groupes équilibrés en fonction d'une donnée et à partir d'une liste.

[mamo8392]

Bonjour à tous,


Je suis nouveau sur le forum. J'ai cherché si ce post existait et je n'ai pas trouvé mon bonheur. Si jamais le sujet a déjà été traité, je m'excuse d'avance pour le doublon et je veux bien avoir le lien de la conversation s'il vous plaît.

Je suis enseignant et je suis plutôt novice sur Excel. Comme le titre l'indique, j'aimerai créer des groupes équilibrés en fonction d'une donnée et à partir d'une liste d'élèves. Concrètement, j'ai une liste de 30 individus où chacun à sa propre vitesse de course. Exemple (noms et données fictives bien sûr) :
- Polo 17
- Lola 15
- Lopo 12
- Lalo 10 etc ...
J'aimerai faire 3 groupes de 10 élèves (vu que j'en ai 30 dans cette exemple), tirés aléatoirement mais je voudrai que la moyenne des vitesses de chaque groupe soit a peu prêt égale (à plus ou moins 1). Le but serait de faires des groupes de même niveau tout en ayant une hétérogénéité d'élèves au sein de chaque groupe.

J'espère que ma requête est assez compréhensible.

Merci d'avance et bonne soirée.


Mamo8392​

 

[Softmama]

Bonsoir mamo8392,

Un petit exemple en PJ. à adapter selon tes besoins, mais qui répond à ta demande.
L'écart maxi de moyenne entre les groupes est affiché en H11, il avoisine plus ou moins 0.3s en général. Les 30 valeurs précises au 1/100è que j'ai mises aléatoirement oscillent entre 11 et 22s, via une formule =ENT(1100*ALEA())/100+11, que j'ai copiée collée en Valeur en colonne B.

Sub goZyva()
Dim derLign As Integer, nbGroup As Integer
Application.ScreenUpdating = False
    derLign = Range("A10000").End(xlUp).Row 'cbien d'élèves ?
    nbGroup = Range("G1")  'cbien de groupes à faire ?
   
    Range("J1:ZZ10000").ClearContents 'effacer les groupes précédents
    Range("C1:C" & derLign).Formula = "=RANK(RC[-1],R1C2:R" & derLign & "C2)" 'On note leur classement selon leurs temps
    Range("D1:D" & derLign).Value = "=rand()"  'On les regroupe x par x, du meilleur au moins bon : les x meilleurs sont répartis chacun aléatoirement dans chacun des x groupes... (x étant le nombre de groupes constitués)
    Range("E1:E" & derLign).Value = "=ROW()"  'Pour remettre dans l'ordre initial ensuite, on note quelle ligne ils occupent avant traitement
    Range("E1:E" & derLign).Copy
    Range("E1:E" & derLign).PasteSpecial xlPasteValues
    Range("C1").Sort key1:=Range("C1"), order1:=xlAscending, Header:=xlNo 'On trie par performance
   
    For t = 1 To nbGroup 'On regarde dans la liste les x premiers et Répartition aléatoire dans les x groupes
     Range("H1").Offset(, 3 * t).Formula = "=INDEX(OFFSET(R1C1,(ROW()-1)*R1C7,0,R1C7,1),MATCH(LARGE(OFFSET(R1C4,(ROW()-1)*R1C7,0,R1C7,1)," & t & "),OFFSET(R1C4,(ROW()-1)*R1C7,0,R1C7,1),0))"
     Range("H1").Offset(, 3 * t - 1).FormulaR1C1 = "=vlookup(RC[1],R1C1:R" & derLign & "C2,2,false)"
    Next t
   
    Range("J1").Resize(1, 3 * t).AutoFill Destination:=Range("J1").Resize(derLign / nbGroup, 3 * t) 'formule pour reproduire ce système à tous les élèves en les prenant x par x
    Range("J1").Resize(derLign / nbGroup, 3 * t).Copy
    Range("J1").PasteSpecial xlPasteValues 'On ne garde que les valeurs des résultats pour les fixer
    For t = 1 To nbGroup 'moyennes de temps de chaque groupe en dessous
      Range("H1").Offset(1000, 3 * t - 1).End(xlUp).Offset(1).Formula = "=average(R1C:R[-1]C)"
    Next t
   
    Range("C1").Sort key1:=Range("E1"), order1:=xlAscending, Header:=xlNo 'On remet la liste dans l'ordre initial
    Range("C:E").Value = "" 'on efface ces colonnes intermédiaires'
   
Application.ScreenUpdating = True
End Sub

Bien cordialement,

 

[mamo8392]

Bonjour Softmama,


Merci énormément pour ton aide. C'est super clair pour appréhender ce monstre

Je vais tout de suite le manipuler et le modifier en fonction de mes besoins.

Merci encore.

Bonne journée.

Mamo8392​

 

[mamo8392]

Re bonjour,

Après plusieurs tests, le fichier fonctionne donc déjà merci beaucoup !

Cependant, quelques petites erreurs apparaissent :

- J'ai rentré 26 élèves d'une classe pour 3 groupes (9, 9 et 8). Dans le groupe de 8 apparait la valeur #NOMBRE! ce qui bloque l'affichage de la moyenne en bas. Est-il possible de ne rien mettre dans la casse vide.

- J'ai ensuite rentré 25 élèves et cette fois ci, le fichier me fait 3 groupes de 8 au lieu d'1 groupe de 9 et 2 groupes de 8. Il ne prend pas en compte l'élève en A14/B14, comment régler ce problème ?

- Vu que j'ai moins d'élèves, la case de la moyenne de chaque groupe remonte dans la colonne et il faut que je change manuellement l'emplacement des cases prises en compte pour l'écart. Est-il possible de bloquer cette case moyenne plus bas dans la colonne de chaque groupe pour que ça ne bouge plus, qu'importe le nombre d'élèves par colonne ?

Merci d'avance et bonne journée.


Mamo8392

 

[Softmama]

Bonsoir,

Quelques modifications donc pour répondre à cette demande :
* Si les groupes ne sont pas complets, le programme prend tout le monde en compte quand même désormais, quels que soient les nombres d'élèves ou de groupes.
* Les moyennes sont affichées en dessous des colonnes, et l'écart également en face.

Sub goZyva()
Dim derLign As Integer, nbGroup As Integer, c As Range
Application.ScreenUpdating = False
    derLign = Range("A1000").End(xlUp).Row 'cbien d'élèves ?
    nbGroup = Range("G1")  'cbien de groupes à faire ?
    If derLign / nbGroup <> Int(derLign / nbGroup) Then 'Si pas groupes au complet, on complète avec des faux participants et un temps à 0
      Range("A" & derLign + 1 & ":A" & (Int(derLign / nbGroup) + 1) * nbGroup) = "Fake"
      Range("B" & derLign + 1 & ":B" & (Int(derLign / nbGroup) + 1) * nbGroup) = 0
      derLign = (Int(derLign / nbGroup) + 1) * nbGroup
    End If
 
    Range("I1:ZZ10000").ClearContents 'effacer les groupes précédents
    Range("C1:C" & derLign).Formula = "=RANK(RC[-1],R1C2:R" & derLign & "C2)" 'Affichage du rang de performance
    Range("D1:D" & derLign).Value = "=rand()"  'Les x meilleurs sont répartis aléatoirement ds un groupe, puis idem les x suivants, x étant le nombre de groupes à constituer
    Range("E1:E" & derLign).Value = "=ROW()" 'clé pour se souvenir de l'ordre initial
    Range("E1:E" & derLign).Copy
    Range("E1:E" & derLign).PasteSpecial xlPasteValues
 
    Range("C1").Sort key1:=Range("C1"), order1:=xlAscending, Header:=xlNo 'On les trie par performance
 
    For t = 1 To nbGroup 'On affiche les résultats
     Range("H1").Offset(, 3 * t).Formula = "=INDEX(OFFSET(R1C1,(ROW()-1)*R1C7,0,R1C7,1),MATCH(LARGE(OFFSET(R1C4,(ROW()-1)*R1C7,0,R1C7,1)," & t & "),OFFSET(R1C4,(ROW()-1)*R1C7,0,R1C7,1),0))"
     Range("H1").Offset(, 3 * t - 1).FormulaR1C1 = "=vlookup(RC[1],R1C1:R" & derLign & "C2,2,false)"
    Next t
 
    Range("J1").Resize(1, 3 * t).AutoFill Destination:=Range("J1").Resize(Int(derLign / nbGroup) + 1, 3 * t)
    On Error Resume Next 'on efface les erreurs
    Cells.SpecialCells(xlCellTypeFormulas, 16).ClearContents
      Cells.SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
    On Error GoTo 0
    Range("J1").Resize(derLign / nbGroup, 3 * t).Copy
    Range("J1").PasteSpecial xlPasteValues
 
    nligne = Range("J1:AA1000").Find("*", , , , , xlPrevious).Row + 2 'Dernière ligne affichée pour y caler les moyennes
    For u = 1 To nbGroup 'Moyenne de temps de chaque groupe
      Range("H" & nligne).Offset(, 3 * u - 1).Formula = "=average(R1C:R[-1]C)"
    Next u
    Range("I" & nligne - 1).Value = "écart maxi :" 'affichage de l'écart
    Range("I" & nligne).FormulaR1C1 = "=MAX(RC[1]:RC[100])-MIN(RC[1]:RC[100])"

    Range("C1").Sort key1:=Range("E1"), order1:=xlAscending, Header:=xlNo 'on remet dans l'ordre initial
    Cells.Replace "Fake", "" 'On efface les faux participants
    Cells.Replace 0, "", lookat:=xlWhole
    Range("C:E").Value = ""
 
Application.ScreenUpdating = True
End Sub

Bonne soirée,