Croiser deux Code VBA

[vincent noah]

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

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:

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 😕

MERCI pour toute aides .

 

[job75]

Re : Croiser deux Code VBA

Bonsoir vincent noah,

Vous devriez arrêter de vous triturer le cerveau avec ce genre de problème.

Vous allez finir par vous faire du mal, en aucun cas mes codes n'en seraient responsables 🙄

A+

 

[vincent noah]

Re : Croiser deux Code VBA

Re, Bonsoir job75

Vous ne voulais plus m'aider ? 😛

A+

 

[job75]

Re : Croiser deux Code VBA

Re,

Vous ne voulais plus m'aider ? 😛

Depuis le début on ne sait pas à quoi peut bien servir votre travail.

Dans ces conditions je préfère en effet ne pas continuer.

Bonne soirée.