Microsoft 365 Tirage au sort tombola

[Poupinette37110]

Bonjour, je souhaite réaliser un tirage au sort pour une tombola à partir de 2 fichiers, un comprenant la liste des lots avec leurs numéros associés (environ 300 lots), et un autre avec le numéro des tickets vendus ainsi que le nom de l'acheteur (environ 1700 tickets). Il y a une ligne par tickets et une ligne par lot.
L'idée serait d'avoir un tirage au sort avec un gagnant par lot et d'obtenir un fichier récapitulatif avec le numéro du ticket, la désignation du lot, le numéro du lot et le nom du gagnant.
Est-ce possible ? Merci d'avance de vos retours.

Sabrina

 

[Dranreb]

Bonsoir.
Il y a des outils qui pourront vous servir dans ce classeur.
Et une application que j'ai retrouvé pour une tombola avec carnets de tickets vendus de différentes couleurs et système pour découvrir un par un les tickets gagnants tirés depuis le lot de moindre valeur jusqu'au premier lot le plus élevé.

 

[patricktoulon]

re
des fichiers auraient été les bien venu pour que l'on puisse travailler dessus

 

[mapomme]

Bonsoir à tous,

Un exemple de ce qu'on peut faire avec un peu de VBA.
On utilise trois tableaux structurés : un pour les lots (nommé tLot), un pour les tickets (nommé tTick) et un dernier pour le résultat du tirage (nommé tTirage).

Cliquez sur le bouton "Tirage".

Le code est dans le module de la feuille "Feuil1" :

Sub tirage()
Dim t(0 To 1), tres, i&, j&, k&, n&, aux
   t(0) = Range("tLot"): t(1) = Range("tTick")
   If Range("tTirage").Rows.Count = UBound(t(0)) Then
      If MsgBox("Un tirage semble déjà avoir été fait !" & vbLf & vbLf & _
                "Attention ! Le précédent tirage sera définitivement perdu. " & vbLf & vbLf & _
                "Voulez vraiment procéder à un nouveau tirage ?", vbQuestion + vbYesNo + vbDefaultButton2) <> vbYes Then Exit Sub
   End If
   Randomize
   For i = 1 To UBound(t(1))
      n = 1 + Int(Rnd * UBound(t(1)))
      For j = 1 To UBound(t(1), 2): aux = t(1)(i, j): t(1)(i, j) = t(1)(n, j): t(1)(n, j) = aux: Next
   Next i
   ReDim res(1 To UBound(t(0)), 1 To 4)
   For i = 1 To UBound(res): res(i, 1) = t(0)(i, 1): res(i, 2) = t(0)(i, 2): res(i, 3) = t(1)(i, 1): res(i, 4) = t(1)(i, 2): Next
   Range("tTirage").Clear: Range("tTirage").Resize(UBound(t(0)), 4) = res
End Sub

 

[Dranreb]

Bonsoir.
En repartant des donnée du classeur de @mapomme (mais qui aurait du être donné par @Poupinette37110), la version qui n'utilise que des formules dont certaines appellent ma fonction personnalisée Hasard, et la macro ChangerGraine pour changer le tirage. Programmation reprise de mon ListeAléat.xlsm joint au #2.

 

[patricktoulon]

re
Bonsoir à tous
je n'ai pas pu m'en empêcher
j'ai repris la feuille de @mapomme

Sub tirage2()
    Dim T, MaxRow, MinRow, matriCe, I&, tp1, tp2
    MaxRow = [tTick].Rows.Count: MinRow = [tlot].Rows.Count
    matriCe = Evaluate("ROW(2:" & MaxRow & ")") 'matrice de ligne pour la fonction index
    T = Application.Index(Range("A:F").Resize(MaxRow).Value, matriCe, Array(1, 2, 5, 6))    'on rassemble les deux tableaux (c'est une union façon patosh :):):) )
    'on inverse 2 ligne au hasard de 1 à MaxRow pour les colonne 3 et 4
    For I = 1 To MinRow
        x = Int(1 + (Rnd * (MaxRow - 1)))
        tp1 = T(I, 3): tp2 = T(I, 4): T(I, 3) = T(x, 3): T(I, 4) = T(x, 4): T(x, 3) = tp1: T(x, 4) = tp2
    Next
    Range("tTirage").Columns("A:B").Clear: Range("tTirage").Resize([tlot].Rows.Count, 4) = T
    
    MsgBox "tirage terminé"
End Sub