Tirage Aléatoire de valeurs dans un tableau

Sub TirageAlé_a()
Dim DateDéb As Date, DateFin As Date, DateTirée As Date, LDéb As Long, LFin As Long, Le As Long, Ls As Long, i As Long
Dim coll As New Collection
Feuil2.Cells.ClearContents
DateDéb = CDate(InputBox("Date mini", "TirageAlé"))
DateFin = CDate(InputBox("Date maxi", "TirageAlé"))
LDéb = 2: LFin = Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row
i = 1
Randomize
'Do Until i = 200
While coll.Count < 5
Le = LDéb + Int(Rnd * (LFin - LDéb + 1))
If Feuil1.Cells(Le, "C").Value <> "" Then
DateTirée = CDate(Feuil1.Cells(Le, "B").Value)
If DateTirée >= DateDéb And DateTirée <= DateFin Then
On Error Resume Next
coll.Add DateTirée
On Error GoTo 0
cpt = 0
 For n = DateTirée To CDate("30/" & Month(DateTirée) & "/" & Year(DateTirée))
  Feuil2.Cells(i, "A").NumberFormat = Feuil1.Cells(Le, "A").NumberFormat
  Feuil2.Cells(i, "A").Value = Feuil1.Cells(Le + cpt, "A").Value
  Feuil2.Cells(i, "B").Value = Feuil1.Cells(Le + cpt, "B").Value
  Feuil2.Cells(i, "C").Value = Feuil1.Cells(Le + cpt, "C").Value: Feuil1.Cells(Le + cpt, "C").ClearContents
  Feuil1.Cells(Le + cpt, "D").Value = "Selectionnée"
  i = i + 1
  cpt = cpt + 1
 Next n
End If
End If
Wend
'Loop
End Sub

Sub TirageAlé_a()
Dim DateDéb As Date, DateFin As Date, DateTirée As Date, LDéb As Long, LFin As Long, Le As Long, Ls As Long, i As Long
Dim coll As New Collection
Feuil2.Cells.ClearContents
DateDéb = CDate(InputBox("Date mini", "TirageAlé"))
DateFin = CDate(InputBox("Date maxi", "TirageAlé"))
LDéb = 2: LFin = Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row
i = 1
nbtirages = 0
limite = 10000
Randomize
'Do Until i = 200
'tant que la collection n'atteint pas le nombre de tirages specifié
While coll.Count < 5
'choisir un N° de ligne entre Ldéb et LFin
Le = LDéb + Int(Rnd * (LFin - LDéb + 1))
'Si la cellule colonne "C" pour la migne concernée n'est pas vide
' ce qui serait le cas si la ligne avait deja été tirée
If Feuil1.Cells(Le, "C").Value <> "" Then
'definir la date tirée : Valeur de la ligne choisie colonne B
DateTirée = CDate(Feuil1.Cells(Le, "B").Value)
'S'assurer que cette date est comprise dans l'intervalle fixé par les inputbox
If DateTirée >= DateDéb And DateTirée <= DateFin Then
'si oui
'enregistrer dans la collection
On Error Resume Next
coll.Add DateTirée
On Error GoTo 0
'initialiser un compteur pour definir la ligne ou ecrire
cpt = 0
'boucle travaillant de la date choisie jusqu'au trente du meme mois de la meme année
 For n = DateTirée To CDate("30/" & Month(DateTirée) & "/" & Year(DateTirée))
 'ecrire en Feuil2
  Feuil2.Cells(i, "A").NumberFormat = Feuil1.Cells(Le, "A").NumberFormat
  Feuil2.Cells(i, "A").Value = Feuil1.Cells(Le + cpt, "A").Value
  Feuil2.Cells(i, "B").Value = Feuil1.Cells(Le + cpt, "B").Value
  Feuil2.Cells(i, "C").Value = Feuil1.Cells(Le + cpt, "C").Value: Feuil1.Cells(Le + cpt, "C").ClearContents
  Feuil1.Cells(Le + cpt, "D").Value = "Selectionnée"
  'incrementer la ligne ou ecrire
  i = i + 1
   'incrementer le compteur pour chaque date entre la date choisie et le trente
  cpt = cpt + 1
 'fin de boucle
 Next n
End If
'increment du nb d'essais
nbtirages = nbtirages + 1
'alerte si nb d'essias depasse la limite
If nbtirages > limite Then
  MsgBox (limite & " tirages effectués sans atteindre le nombre souhaité")
  Exit Sub
End If
End If
Wend
'Loop
End Sub

Sub TirageAlé_a()
Dim DateDéb As Date, DateFin As Date, DateTirée As Date, LDéb As Long, LFin As Long, Le As Long, Ls As Long, i As Long
'creer un dictionaire qui contiendra les ref tirées
Set d = CreateObject("scripting.dictionary")
Feuil2.Cells.ClearContents
DateDéb = CDate(InputBox("Date mini", "TirageAlé"))
DateFin = CDate(InputBox("Date maxi", "TirageAlé"))
LDéb = 2: LFin = Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row
i = 1
nbtirages = 0
limite = 10000
Randomize
'Do Until i = 200
'tant que le nbre de ref dans le dictionaire n'atteint pas le nombre de tirages specifié
While d.Count < 4
'choisir un N° de ligne entre Ldéb et LFin
Le = LDéb + Int(Rnd * (LFin - LDéb + 1))
'definir la date tirée : Valeur de la ligne choisie colonne B
DateTirée = CDate(Feuil1.Cells(Le, "B").Value)
'definir la reference associée
ref = Feuil1.Cells(Le, "A").Value
'S'assurer que cette date est comprise dans l'intervalle fixé par les inputbox
'et que la ref n'est pas deja dans le dictionaire
If DateTirée >= DateDéb And DateTirée <= DateFin And Not d.exists(ref) Then
'si oui
'mettre la ref dans le dictionaire
d(ref) = ref
'initialiser un compteur pour definir la ligne ou ecrire
cpt = 0
'boucle travaillant de la date choisie jusqu'au trente du meme mois de la meme année
 For n = DateTirée To CDate("30/" & Month(DateTirée) & "/" & Year(DateTirée))
 'ecrire en Feuil2
  Feuil2.Cells(i, "A").NumberFormat = Feuil1.Cells(Le, "A").NumberFormat
  Feuil2.Cells(i, "A").Value = Feuil1.Cells(Le + cpt, "A").Value
  Feuil2.Cells(i, "B").Value = Feuil1.Cells(Le + cpt, "B").Value
  Feuil2.Cells(i, "C").Value = Feuil1.Cells(Le + cpt, "C").Value
  Feuil1.Cells(Le + cpt, "C").ClearContents
  Feuil1.Cells(Le + cpt, "D").Value = "Selectionnée"
  'incrementer la ligne ou ecrire
  i = i + 1
   'incrementer le compteur pour chaque date entre la date choisie et le trente
  cpt = cpt + 1
 'fin de boucle
 Next n
End If
'increment du nb d'essais
nbtirages = nbtirages + 1
'alerte si nb d'essias depasse la limite
If nbtirages > limite Then
  MsgBox (limite & " tirages effectués sans atteindre le nombre souhaité")
  Exit Sub
End If
Wend
'Loop
End Sub