Croiser deux Code VBA

vincent noah

XLDnaute Junior
Bonjour à tous !

je souhaite croiser deux code (proposé gentillement par job75) pour que le premier tir aléatoirement et sans doublons un nombre défini de tirage ex: 10
qui sont colorier en bleu.
en suite à partir du dixième tirages .on continu uniquement sur les cellules non colorée jusqu'à ce qu'une cellule contient un 5 ou un 4 ... c'est pas facile de l’expliquer j'ai essayer mais sans succès me parait très difficile . 1er code :
.
Code:
Private Sub Worksheet_Calculate()
Dim r As Range, limite, decharge&, nc&, d As Object
Dim c As Range, bleu As Range, n&
Set r = [A1:A30]
limite = [D2]
decharge = 500
nc = r.Count
r.Interior.ColorIndex = xlNone 'RAZ
Randomize
Set d = CreateObject("Scripting.Dictionary")
While d.Count < limite
  Set c = r(Int(1 + Rnd * nc))
  If Not d.exists(c.Value) Then
    d(c.Value) = ""
    Set bleu = Union(c, IIf(bleu Is Nothing, c, bleu))
    n = n + 1
    If n Mod decharge = 0 Then 'décharge
      bleu.Interior.ColorIndex = 47 'bleu
      Set bleu = Nothing
    End If
  End If
Wend
If Not bleu Is Nothing Then bleu.Interior.ColorIndex = 47  'bleu
If Not c Is Nothing Then c.Interior.ColorIndex = 3 'rouge
End Sub
et le deuxième:
Code:
Sub Tirage()
Dim r As Range, cible, ncoul As Range, nc&, d As Object, c As Range
Set r = [A1:A30] 'plage à adapter
cible = 4 or 5 'à adapter
Set ncoul =  [E2]'nombre de tirages total 
r.Interior.ColorIndex = xlNone 'RAZ
ncoul = ""
If Application.CountIf(r, cible) = 0 Then _
  MsgBox "Valeur cible introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Randomize
nc = r.Count
Set d = CreateObject("Scripting.Dictionary")
Do
  Set c = r(Int(1 + Rnd * nc))
  If c <> "" And Not d.exists(c.Value) Then
    d(c.Value) = ""
    c.Interior.ColorIndex = 47 'bleu
  End If
Loop While c <> cible
c.Interior.ColorIndex = 3 'rouge
ncoul = d.Count
End Sub

voilà j'espère que j'ai étais claire :confused:

MERCI pour toute aides .
 

Pièces jointes

  • Classeur1 2015.xlsm
    16.2 KB · Affichages: 32

Statistiques des forums

Discussions
312 472
Messages
2 088 715
Membres
103 932
dernier inscrit
clotilde26