Tirage au sort

Question

Bonjour, 

J'aimerais créer un tirage au sort à l'aide d'un bouton d'action.
40 chiffres à répartir en 3 parties
entre B4:B16
B19:B31
B41:B54

Merci

Configuration: Windows 7 / Internet Explorer 8.0

Vaucluse · Answer

Bonjour
est ce que ceci ferait l'affaire

http://www.cijoint.fr/cjlink.php?file=cj201105/cijgP4hQb5.xls



revenez si besoin

crdlmnt

ccm81 · Answer

bonjour a tous les deux

une autre proposition qui fonctionne dans un temps raisonnable si la plage n'est pas trop vaste

Option Explicit
Option Base 1

Private Sub CommandButton1_Click()
Const plage1 = "B4:B16"
Const plage2 = "B19:B31"
Const plage3 = "B41:B54"
Const n = 40
Dim T(n) As Long
Dim c
Dim plage As Range
Dim k As Long, i As Long, a As Long
Dim Trouve As Boolean
Set plage = Union(Range(plage1), Range(plage2), Range(plage3))
For k = 1 To n
  T(k) = 0
Next k
T(1) = 1 + Int(n * Rnd)
For k = 2 To n
  Do
    Trouve = False
    a = 1 + Int(n * Rnd)
    For i = 1 To k - 1
      Trouve = Trouve Or a = T(i)
    Next i
  Loop Until Not Trouve
  T(k) = a
Next k
 Set plage = Union(Range(plage1), Range(plage2), Range(plage3))
k = 0
For Each c In plage
  k = k + 1
  c.Value = T(k)
Next c
End Sub

bonne suite

ccm81 · Answer

re

j'avais choisi l'option de mettre un bouton (activeX) dans la feuille, mais on peut se débrouiller sans en mettant la procedure dans un module  moyennant quelques modifs

Option Explicit
Option Base 1

Public Sub Tirage()
Const plage1 = "B4:B16"
Const plage2 = "B19:B31"
Const plage3 = "B41:B54"
Const n = 40
Dim T(n) As Long
Dim c
Dim plage As Range
Dim k As Long, i As Long, a As Long
Dim Trouve As Boolean
For k = 1 To n
  T(k) = 0
Next k
T(1) = 1 + Int(n * Rnd)
For k = 2 To n
  Do
    Trouve = False
    a = 1 + Int(n * Rnd)
    For i = 1 To k - 1
      Trouve = Trouve Or a = T(i)
    Next i
  Loop Until Not Trouve
  T(k) = a
Next k
With Sheets(1) ' ici tu mets ton n° de feuille ou son "nom"
  Set plage = Union(.Range(plage1), .Range(plage2), .Range(plage3))
  k = 0
  For Each c In plage
    k = k + 1
    c.Value = T(k)
  Next c
End With
End Sub

tu as les deux options ici

http://www.cijoint.fr/cjlink.php?file=cj201105/cijK8P0Fxh.xls

bonne suite

michel_m · Answer

Bonjour à tous 

Une  ptite rapide 

Sub tirage_sans_remise() 
Dim gagnants As Object 
Dim cptr As Byte 
Dim elus 

Randomize 
Set gagnants = CreateObject("scripting.dictionary") 
For cptr = 1 To 40 
     tirage = Int(Rnd * 200) + 1 
     If Not gagnants.exists(tirage) Then 
          gagnants.Add tirage, tirage 
     Else 
          cptr = cptr - 1 
     End If 
Next 
elus = gagnants.items 

Application.ScreenUpdating = False 
Range("B4").Resize(40, 1) = Application.Transpose(elus) 
Range("A17:A18").EntireRow.Insert 
Range("A32:A40").EntireRow.Insert 


End Sub 

 Michel

ccm81 · Answer

re 
une autre solution, moins sophistiquée que celle de michel, mais .... 

Option Explicit 

Private Sub CommandButton1_Click() 
Const plage1 = "B4:B16" 
Const plage2 = "B19:B31" 
Const plage3 = "B41:B54" 
Const n = 40 
Dim T(40) As Long 
Dim c 
Dim plage As Range 
Dim k As Long, a As Long, b As Long 
For k = 1 To n 
  T(k) = k 
Next k 
For k = 1 To n 
  a = 1 + Int(40 * Rnd) 
  b = T(k) 
  T(k) = T(a) 
  T(a) = b 
Next k 
Set plage = Union(Range(plage1), Range(plage2), Range(plage3)) 
k = 0 
For Each c In plage 
  k = k + 1 
  c.Value = T(k) 
Next c 
End Sub 
bonne journée

michel_m · Answer

re,

pour la petite modif, le demandeur ne semble (ou plutôt j'ai mal lu) pas avoir dit qu'il s'agissait de nombres 1 à 40, j'ai mis 200 comme j'aurais pu mettre 12345

l'objet dictionary est un truc "magique" de VBA: il ne prend que les éléments uniques et possède une clé et un item par exemple on cherche la 1° ligne où 
on recontre une ref, ce qui est très rapide car n'obligeant pas une gestion d'erreur (on error resume..)


clé=cells(lig,col)
ref=cells(lig,col).row
if not dico.exists(cle) then
    dici.add clé, ref

pour retrouver la ligne rapidement
clé_out=cells(lig1, col1).value
if dico.exist(cells(clé_out)
ligne=dico.item(clé_out)

dans notre cas comme la clé et la ref sont les m^mes on marque add cle, cle

a noter que ref peut-etre du type range("A1:T1") ou une variable-tableau ou...

d'autre part le dico peut être restitué sous forme de variable-tableaux
liste_ref=dico.items
liste_cle=liste.keys
la restitution dans les cellules est ainsi très rapide par l'instruction que j'ai employé
Range("B4").Resize(40, 1) = Application.Transpose(elus) 

je te mets ci joint une démo faite sur ccm,  sans coucou de remerciement de la part du demandeur comme d'hab, pour une traduction d'une moyenne de 54000 mots tirés au sort sur 10000 lignes avec un dico anglais-francais de 1000 mots 

la démo t'indique le temps passé 0,8 secondes avec mon vieux coucou
https://www.cjoint.com/?0ErmQtgkXBp

d'autre part si tu ne le connais pas un tuto sur les variables tableaux
https://silkyroad.developpez.com/vba/tableaux/

crois moi, ca vaut le coup d'investir dans ces 2 possibilités car ca ouvre de sacrées solutions surtout dans des grands tableaux

En espèrant que cela t'interessera...

Tirage au sort

6 réponses

Votre réponse

Discussions similaires

Newsletters