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