tirage aléatoire sans doublon

HASSANI

XLDnaute Nouveau
Bonsoir
Vous trouvez ci-joint mon fichier Excel ou j'ai fait un macro de tirage aléatoire, mais j'ai eu un petit souci le Macro me fait sortir des noms en plusieurs fois " en double "
svp j'ai besoin de ce macro
Merci d’avance
 

Pièces jointes

  • tirage_Alea.xlsm
    155.3 KB · Affichages: 62

Dranreb

XLDnaute Barbatruc
Voyez si vous ne pourriez utiliser cette procédure :
VB:
Private Sub InitAléa(TLong() As Long, ByVal Nombre As Long)
Dim P As Long, A As Long, B As Long
ReDim TLong(1 To Nombre)
For P = 1 To Nombre: TLong(P) = P: Next P
Randomize
For P = Nombre To 2 Step -1
   A = Int(Rnd * P) + 1: B = TLong(A): TLong(A) = TLong(P): TLong(P) = B
   Next P
End Sub
Exemple d'utilisation :
VB:
Sub Test()
Dim TL() As Long, R(1 To 20) As String, N As Long
InitAléa TL, 20  ' Initialisation de TL à 20 nombres uniques en désordre allant de 1 à 20.
For N = 1 To 20
   R(N) = Format(TL(N), "00")
   Next N
MsgBox Join(R, ", ")
End Sub
 

Dranreb

XLDnaute Barbatruc
Et je crois que j'ai compris ce que vous vouliez en faire.
Alors voici le code complet de votre Module1 :
VB:
Option Explicit

Sub Liste()
' liste moteur de recherche
Dim TF(), LF As Long, TNoms(), NMax As Long, TA() As Long, _
   NDem As Long, N As Long, LR As Long, TR(1 To 80, 1 To 2)
TF = Feuil1.[E5:F11].Value
For LF = 1 To UBound(TF, 1)
   TNoms = ThisWorkbook.Worksheets(TF(LF, 1)).UsedRange.Value
   NMax = UBound(TNoms, 1)
   InitAléa TA, NMax
   NDem = TF(LF, 2): If NDem > NMax Then NDem = NMax
   For N = 1 To NDem
      LR = LR + 1: TR(LR, 1) = LR: TR(LR, 2) = TNoms(TA(N), 1)
      Next N, LF
Feuil1.[A12].Resize(80, 2).Value = TR
End Sub

Private Sub InitAléa(TA() As Long, ByVal Nombre As Long)
Dim P1 As Long, P2 As Long, A As Long
ReDim TA(1 To Nombre)
For P1 = 1 To Nombre: TA(P1) = P1: Next P1
Randomize
For P1 = Nombre To 2 Step -1
  P2 = Int(Rnd * P1) + 1
  A = TA(P2): TA(P2) = TA(P1): TA(P1) = A
  Next P1
End Sub
 
Dernière édition:

Statistiques des forums

Discussions
312 182
Messages
2 086 001
Membres
103 084
dernier inscrit
Hervé30120