prendre aléatoirement des cellules

[mgrizzly]

Bonjour,
Dans la colonne C de mon tableau (de la ligne 9 à 59) il y a des 1 et des 0.
J'aurais besoin d'un code en VBA qui prenne aléatoirement 3 cellules de la colonne C et uniquement parmi celles qui ont des 1.
Merci de m'aider.

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Re

essaye ainsi, à condition que la couleur ne soit pas déterminée par une mise en forme conditionnelle, mais attention si pas assez de cellules de couleur rouge, ca risque de boucler indéfiniment...

Option Explicit
Sub Test()
Dim i As Byte, y() As Variant, z() As Variant, x As Integer, c As New Collection
Randomize
y = Array(16, 17, 18)
z = Array(9, 25, 42)
For i = 0 To 2
    Do While c.Count < 3
        x = Int(y(i) * Rnd + z(i))
        If Cells(x, 3) = 1 Then
            On Error Resume Next
            If Cells(x, 3).Interior.ColorIndex <> 3 Then _
                c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
            If Err = 0 Then
                With Sheets("Mois en cours").Range("F4")
                    .Value = .Value & Cells(x, 3).Address(0, 0) & vbLf
                End With
            End If
            On Error GoTo 0
        End If
    Loop
    Set c = Nothing
Next i
End Sub

@+

 

[mgrizzly]

Re : prendre aléatoirement des cellules

Merci Pierrot et maintenant est-ce qu'il serait possible de ne pas mettre les cellules trouvées dans les cellules jaunes de la feuille "mois en cours"?

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Bonjour,

tu peux les mettre où tu veux en adaptant cette ligne :

With Sheets("Mois en cours").Range("F4")

bon après midi
@+

 

[mgrizzly]

Re : prendre aléatoirement des cellules

Non, je veux dire ne plus mettre les cellules trouvées dans la cellule F4 de la feuille mois en cours mais dans toutes les cellules de la colonne F de la feuille mois en cours, sans remplir les cellules jaunes.
Commencer en F4 et finir en F34.

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Re

essaye comme cela :

Option Explicit
Sub Test()
Dim i As Byte, y() As Variant, z() As Variant, x As Integer, c As New Collection
Dim p As Range
Randomize
y = Array(16, 17, 18)
z = Array(9, 25, 42)
For i = 0 To 2
    Do While c.Count < 3
        x = Int(y(i) * Rnd + z(i))
        If Cells(x, 3) = 1 Then
            On Error Resume Next
            If Cells(x, 3).Interior.ColorIndex <> 3 Then _
                c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
            If Err = 0 Then
                For Each p In Sheets("Mois en cours").Range("F4:F34")
                    If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then
                        p.Value = Cells(x, 3).Address(0, 0)
                        Exit For
                    End If
                Next p
            End If
            On Error GoTo 0
        End If
    Loop
    Set c = Nothing
Next i
End Sub

 

[mgrizzly]

Re : prendre aléatoirement des cellules

Ok merci Pierrot!
ça fonctionne mais plus rien ne s'écrit à partir de la ligne 22.
Et sinon comment faire pour ne plus mettre l'adresse de la cellule dans la feuille mois en cours mais le contenu de la cellule de la colonne A dans la première feuille?

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Re

Pour ta 1ère question, faudrait voir le classeur en question, plus de cellules vides ou alors elles sont jaunes dans la feuille "mois en cours".

pour ta 2ème question, remplace cette ligne :

p.Value = Cells(x, 3).Address(0, 0)

par :

p.Value = Cells(x, [COLOR="Red"][B]1[/B][/COLOR]).[COLOR="red"][B]Values[/B][/COLOR]

 

[mgrizzly]

Re : prendre aléatoirement des cellules

OK mais rien ne s'affiche dans les cellules maitement est-ce parce que la colonne A est remplie grâce à des formules ?

=1 cellule A9
=NBVAL(A$9ECALER(A10;-1;0))+A$9 cellule A10
=NBVAL(A$9ECALER(A11;-1;0))+A$9 cellule A11
...

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Re

mets un fichier en pièce jointe, plus facile pour t'aider...

 

[mgrizzly]

Re : prendre aléatoirement des cellules

Après vérification avec la valeur des cellules d'une autre colonne ça ne marche pas non plus! C'est donc bien la valeur des cellules qu'il ne veut pas prendre. Une idée?

 

[mgrizzly]

Re : prendre aléatoirement des cellules

J'ai pensé qu'il faudrait dire au code d'enlever la première lettre lorqu'il met l'adresse ainsi j'aurais quand même mes numéros! Est-ce possible?

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Re

la propriété "values" n'est pas valide avec cells, modifies comme suit :

Option Explicit
Sub Test()
Dim i As Byte, y() As Variant, z() As Variant, x As Integer, c As New Collection
Dim p As Range
Randomize
y = Array(16, 17, 18)
z = Array(9, 25, 42)
For i = 0 To 2
    Do While c.Count < 3
        x = Int(y(i) * Rnd + z(i))
        If Cells(x, 3) = 1 Then
            On Error Resume Next
            If Cells(x, 3).Interior.ColorIndex <> 3 Then _
                c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
            If Err = 0 Then
                For Each p In Sheets("Mois en cours").Range("F4:F34")
                    If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then
                        p.Value = Cells(x, 1)
                        Exit For
                    End If
                Next p
            End If
            On Error GoTo 0
        End If
    Loop
    Set c = Nothing
Next i
End Sub

Edition : essentiellement "value" avec un "s"... pffffff

 

[mgrizzly]

Re : prendre aléatoirement des cellules

OK ça marche mais le problème maintenant c'est qu'il ne prend plus q'une cellule et non plus les 9.

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Re,

ce code, chez moi, renvoie bien 9 valeurs... sans voir le fichier utilisé dur de t'aider plus....

 

[Pierrot93]

Re : prendre aléatoirement des cellules

Re

essaye cette version, un peu mieux optimisée...

Option Explicit
Sub test()
Dim i As Byte, y() As Variant, z() As Variant, x As Integer, c As New Collection
Dim p As Range
Randomize
y = Array(16, 17, 18)
z = Array(9, 25, 42)
For i = 0 To 2
    Do While c.Count < 3
        x = Int(y(i) * Rnd + z(i))
        If Cells(x, 3) = 1 And Cells(x, 3).Interior.ColorIndex <> 3 Then
            On Error Resume Next
            c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
            If Err = 0 Then
                On Error GoTo 0
                For Each p In Sheets("Mois en cours").Range("F4:F34")
                    If p.Interior.ColorIndex <> 6 And IsEmpty(p.Value) Then
                        p.Value = Cells(x, 1).Value
                        Exit For
                    End If
                Next p
            End If
            On Error GoTo 0
        End If
    Loop
    Set c = Nothing
Next i
End Sub