Microsoft 365 Tirage au sort tombola

Poupinette37110

XLDnaute Nouveau
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

XLDnaute Barbatruc
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é.
 

Pièces jointes

  • ListeAléat.xlsm
    634.5 KB · Affichages: 4
  • ListeAléatNike780.xlsm
    60.5 KB · Affichages: 4
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
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" :
VB:
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
 

Pièces jointes

  • Poupinette37110- Tombola- v1.xlsm
    61.2 KB · Affichages: 8

Dranreb

XLDnaute Barbatruc
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.
 

Pièces jointes

  • HasardPoupinette37110.xlsm
    92.4 KB · Affichages: 9

patricktoulon

XLDnaute Barbatruc
re
Bonsoir à tous
je n'ai pas pu m'en empêcher 🤣
j'ai repris la feuille de @mapomme
VB:
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
 

Statistiques des forums

Discussions
313 195
Messages
2 096 101
Membres
106 495
dernier inscrit
dylan.44