Tirage au sort

Bonjour
est ce que ceci ferait l'affaire

http://www.cijoint.fr/cjlink.php?file=cj201105/cijgP4hQb5.xls

revenez si besoin

crdlmnt

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

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

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

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

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