Mélanger aléatoirement une liste de personne

Bonjour le Forum!

J'ai besoin de votre aide pour un programme qui reprendrai le principe du jeu killer party.
Le principe est simple : chaque participant à une arme pour tuer un autre participant, dénommé "victime". Chaque fois qu'un participant "tue" sa victime, il récupère alors la cible et l'arme de sa victime et le jeu continue ainsi de suite jusqu'à qu'il y ait un seul vainqueur.

Mon programme est le suivant :

- l'organisateur du jeu rentre le nom des participants dans la feuille "Accueil" ainsi que le nom des armes.
- ensuite il lance le jeu pour que le programme assigne (dans la feuille "jeu") à chaque participant une arme (donnée aléatoirement) et une victime (un autre participant) à condition que le nom du participant et celui de la victime ne soit pas identique et qu'il n'y ai pas de couple participant/victime "seul" (A tue B et B tue A).

Je bloque donc sur la partie random qui doit assigner une arme aléatoirement dans la feuille jeu et une victime en respectant les conditions précédentes.

J'espère que c'est suffisamment claire...

Merci d'avance pour votre aide!!

Salut,

Je ne suis pas sûr de comprendre toute l'étendue de ton problème mais tu peux attribuer des valeurs aléatoire gràce à la fonction =alea().

Tu pourrais donc créer des listes de références ou une valeur est affectée entre 0 et 1. Et ensuite avec un vlookup, assigner aléatoirement l'arme ou le candidat en recherchant dans la liste de référence la valeur la plus proche.

Hope it helps.

Bonjour,

je ferais ainsi. D'abord mélanger, ensuite affecter :

Sub Partie()
    Dim nbj As Long, joueur, arme, result()
    Dim i As Long, j As Long, tmp
    Application.ScreenUpdating = False

    'Dernière ligne de la colonne participant
    nbj = Sheets("Accueil").Range("C65536").End(xlUp).Row - 10

    'recup joueurs, armes
    joueur = [C11].Resize(nbj)
    arme = [E11].Resize(nbj)
    ReDim result(1 To nbj, 1 To 3)

    'mélanger joueurs/armes
    Randomize
    For i = 1 To UBound(joueur)
        j = Int(Rnd * nbj) + 1
        tmp = joueur(i, 1): joueur(i, 1) = joueur(j, 1): joueur(j, 1) = tmp
        j = Int(Rnd * nbj) + 1
        tmp = arme(i, 1): arme(i, 1) = arme(j, 1): arme(j, 1) = tmp
    Next i

    'On copie la liste de participant dans la feuille jeu
    'On affecte a chaque participant une cible et une arme
    For i = 1 To nbj
        result(i, 1) = joueur(i, 1)
        result(i, 2) = joueur(i Mod nbj + 1, 1)
        result(i, 3) = arme(i, 1)
    Next

    'coller jeu
    With Worksheets("Jeu")
        .[B3].Resize(nbj, 3) = result
        .Select
    End With
End Sub

eric

Bonjour à tous,

J'étais parti sur un dico en supprimant les valeurs au fur et à mesure de leur incrémentation sur la feuille 2 mais j'ai abandonné au vu de la solution plus simple d'eriiic.

Eriiic,
J'ai une question qui me turlupine car je peine vraiment à me représenter les arrays/listes/dico malgré l'exploration via les variables locales ... Comment dans ton code tu arrives à ne pas avoir de personnes qui ne sont pas leur propre victime ? Via le result(i, 2) = joueur(i Mod nbj + 1, 1) qui renvoie la ligne d'en dessous de ton tableau joueur randomizé ?

En tout cas très impressionnant ce petit code, je vais essayer de m'en souvenir merci beaucoup !

Cdlt,

Bonjour ergotamine,

en fait, après avoir mélangé les joueurs, je donne en cible le suivant dans la liste, et le premier au dernier. D'où le Mod
Ainsi je suis sûr de respecter les règles sans m'embêter avec des tests, sauf si seulement 2 joueurs bien entendu
eric

Bonjour,

Oui j'étais parti dans les tests et règles vu le niveau basique de mes connaissances et manipulations en array, je me doutais qu'il y avait plus astucieux ! J'y aurai encore été ce soir ... En tout cas le fait de passer par un tableau temporaire pour randomizé est quelque chose à laquelle je devrais penser à l'avenir !

C'est tellement limpide pour toi, bravo pour l'ensemble de tes réponses et ton partage !

Cdlt,

Bonjour Eriiic,
Bonjour Ergotamine,

Un grand merci! C'est top!!
J'ai encore quelques progrès à faire ;)

Bonne journée à tous