Tirage au sort

Bonjour à tous,

Je suis novice en VBA, voila j'ai donc besoin de vos lumières. Je souhaiterais faire une macro suivant plusieurs critères :

  • Effectuer un tirage au sort aléatoire.
  • Pouvoir ajouter ou supprimer des lignes à la colonne "Nom" qui serais comptabilisé dans la cellule "G3" sans avoir à modifier la macro
  • Modifier le nombre de personne tiré au sort cellule "G4"
  • et indiquer les sélectionnés par des croix comme dans la colonne sélection du tableau en pièce jointe.

Je vous remercie vraiment de l'aide que vous m'apporterais dans ce projet, je vous joint le fichier exemple en espérant que cela illustre mieux mes propos.

53echantionnage.xlsm (16.70 Ko)

Bonjour,

Proposition :

Sub Tirage()
    Dim Tir(), tir0$, tir1$, i%, n%, t%, x%
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        t = .Range("G4"): ReDim Tir(n - 1)
        For i = 1 To n - 1
            tir0 = tir0 & ChrW(i + 32)
        Next i
        Randomize
        Do
            x = Int(Len(tir0) * Rnd + 1)
            tir1 = tir1 & Mid(tir0, x, 1)
            tir0 = Replace(tir0, Mid(tir0, x, 1), "")
        Loop While Len(tir0) > 1
        tir1 = tir1 & tir0
        For i = 1 To t
            x = Int(Len(tir1) * Rnd + 1)
            tir0 = Mid(tir1, x, 1)
            Tir(AscW(tir0) - 32) = "x"
            tir1 = Replace(tir1, tir0, "")
        Next i
        .Range("B2:B" & n).ClearContents
        For i = 1 To n - 1
            If Tir(i) = "x" Then .Cells(i + 1, 2) = "x"
        Next i
    End With
End Sub

NB-On procède à un mélange avant tirage final.

NB2- Méthode string-Galopin (l'essayer c'est l'adopter !)

Cordialement.

MFERRAND vous êtes un genie,

Je vous remercie infiniment je chercher cela depuis des semaines.

"On ne sais rien sans l'avoir appris, ne rougis pas d'être apprenti avant d'être maître => Henri-Frederic Amiel 1848"

J'espère un jour pouvoir devenir aussi performant que vous.

cdtl.

Bonjour,

Ta question posée en MP concernant l'adaptation : les deux éléments variables sont d'une part le nombre de pesonnes participant au tirage, ici prélevé directement de la liste avec n (dernière ligne de la liste), le nombre étant donc n-1 puisque la liste commence ligne 2 [on fait d'une pierre 2 coups, car on a simultanément le nombre et l'emplacement où il faudra fournir le résultat], et d'autre part le nombre de personne à tirer (ici, G4).

Evidemment si on commence la liste en B12 (au lieu de A2) et si on met les croix en L (au lieu de B), il faut adapter !

Tu peux le faire directement avec :

n = .Cells(.Rows.Count, 2).End(xlUp).Row

Et ensuite le nombre de candidat sera : n - 11

Et lors de l'affectation des résultats :

If Tir(i) = "x" Then .Cells(i + 11, 12) = "x"

il faut également adapter...

Ou bien, en nommant des plages tu évites d'avoir à retoucher la procédure...

Sub Tirage()
    Dim Tir(), tir0$, tir1$, i%, k%, n%, t%, x%
    k = 12
    With ActiveSheet
       n = [Liste].Rows.Count
        t = [Nombre]: ReDim Tir(n)
        For i = 1 To n
            tir0 = tir0 & ChrW(i + 32)
        Next i
        Randomize
        Do
            x = Int(Len(tir0) * Rnd + 1)
            tir1 = tir1 & Mid(tir0, x, 1)
            tir0 = Replace(tir0, Mid(tir0, x, 1), "")
        Loop While Len(tir0) > 1
        tir1 = tir1 & tir0
        For i = 1 To t
            x = Int(Len(tir1) * Rnd + 1)
            tir0 = Mid(tir1, x, 1)
            Tir(AscW(tir0) - 32) = "x"
            tir1 = Replace(tir1, tir0, "")
        Next i
        .Range("B2:B" & n).ClearContents
        For i = 1 To n
            If Tir(i) = "x" Then .Cells(i, k) = "x"
        Next i
    End With
End Sub

Tu nommes par exemple Liste ta liste de candidats, Nombre la cellule qui contient le nombre à tirer.

Les noms étant pris en compte dans la procédure, tu adaptes tes plages et tu n'as plus à modifier la procédure.

sauf un élément : variable k rajoutée pour indiquer la colonne des résultats, l'affectation se fait en tout début de procédure, et c'est la seule chose restant éventuellement à adapter dans la procédure.

J'ai surligné les lignes modifiées en utilisant cette méthode.

Cordialement.

MFerrand,

Encore une fois merci ce forum, est super réactif, je suis content de m'être inscrit, et j'espère un jour aussi pouvoir porter des solutions.

Cordialement.

Merci et bonne continuation.

Rechercher des sujets similaires à "tirage sort"