créer des groupes à partir d'une liste

starz

XLDnaute Occasionnel
Bonjour à tous,
J'aurais besoin d'un coup de main pour créer 5 groupes de 4 personnes (feuille QUALIF) à partir d'une liste de 20 Pseudo (et nom prénom)

je voudrais créer des groupes aléatoirement mais 1 seul fois. Les pseudo doivent apparaîtrent sur la feuille QUALIF

Il y a aussi la possibilité d'avoir un groupe de 2 ou 3 si la liste de base ne contient pas les 20 pilotes.

je vous joins un fichier pour exemple
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Hello
un test avec ce code
VB:
Sub qualif()
Dim tablo() As Variant
Dim tablo2() As Variant

tablo = Sheets("PILOTES").Range("B3:B22").Value
ReDim tablo2(1 To UBound(tablo, 1), 2)
For i = LBound(tablo2, 1) To UBound(tablo2, 1)
    tablo2(i, 1) = ""
Next i
i = 1
While tablo2(UBound(tablo2, 1), 1) = ""
    DejaTiré = False
    tirage = WorksheetFunction.RandBetween(1, 20)
    For j = LBound(tablo2, 1) To UBound(tablo2, 1)
        If tablo2(j, 1) = tirage Then
            DejaTiré = True
            Exit For
        End If
    Next j
    If Not DejaTiré Then
        tablo2(i, 1) = tirage
        tablo2(i, 2) = tablo(tirage, 1)
       
        i = i + 1
        DejaTiré = False
    End If
Wend

 saut = 0
For i = LBound(tablo2, 1) To UBound(tablo2, 1)
   Sheets("Qualif").Range("D2").Offset(i + saut, 0) = tablo2(i, 2)
   If i Mod 4 = 0 Then saut = saut + 1
Next i

End Sub
 

vgendron

XLDnaute Barbatruc
Avec une modif pour les cas ou il y a moins de 20 (ou plus) de personnes
VB:
Sub qualif()
Dim tablo() As Variant
Dim tablo2() As Variant
nb = Sheets("PILOTES").Range("B" & Rows.Count).End(xlUp).Row 'récupère la dernière ligne de la colonne B

tablo = Sheets("PILOTES").Range("B3:B" & nb).Value 'on met les valeurs dans un tablo
ReDim tablo2(1 To UBound(tablo, 1), 2) 'on définit le tablo2 sur deux colonnes
For i = LBound(tablo2, 1) To UBound(tablo2, 1) 'on remplit la première colonne de tablo2 avec du vide
    tablo2(i, 1) = ""
Next i
i = 1
While tablo2(UBound(tablo2, 1), 1) = "" 'tant qu'on a rien mis dans la dernière ligne du tablo2
    DejaTiré = False
    tirage = WorksheetFunction.RandBetween(1, nb - 2) 'on fait un tirage
    For j = LBound(tablo2, 1) To UBound(tablo2, 1) 'on cherche le tirage dans tablo2
        If tablo2(j, 1) = tirage Then
            DejaTiré = True
            Exit For
        End If
    Next j
    If Not DejaTiré Then 'si pas trouvé
        tablo2(i, 1) = tirage 'on met la valeur en colone 1
        tablo2(i, 2) = tablo(tirage, 1) 'on récupère le nom pour le mettre en colonne 2: ex si tirage = 5--> on met le 5eme nom
      
        i = i + 1
        DejaTiré = False
    End If
Wend
'ici on a rempli le tablo2 avec tous les noms présents dans le désordre
saut = 0
For i = LBound(tablo2, 1) To UBound(tablo2, 1) 'on replace tout le monde dans la feuille Qualif
   Sheets("Qualif").Range("D2").Offset(i + saut, 0) = tablo2(i, 2)
   If i Mod 4 = 0 Then saut = saut + 1
Next i
End Sub
 

vgendron

XLDnaute Barbatruc
ha pardon,
il s'agit d'une macro qu'il faut mettre dans un module standard VBA
1) ouvrir l'éditeur : Alt+F11
2) à gauche, insérer nouveau module stantard

3) à droite dans la fenetre de code: coller le code

voir PJ ; j'ai ajouté un bouton pour lancer le code
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas