prendre aléatoirement des cellules

mgrizzly

XLDnaute Junior
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.
 

mgrizzly

XLDnaute Junior
Re : prendre aléatoirement des cellules

Voilà comment j'ai commencé mon code :
Sub FIP_AIP_MUSC()

Dim cel
Dim choix As String
Dim plage As String
plage = "C9:C59"

For Each cel In Worksheets("Compétences").Range(plage)
If cel.Value = 1 Then ???


End If
Next cel

End Sub

Quelqu'un peut-il m'aider ?
 

Pierrot93

XLDnaute Barbatruc
Re : prendre aléatoirement des cellules

Bonjour Mgrizzly, vbacrumble

essaye peut être le code ci-dessous :

Code:
Option Explicit
Sub Test()
Dim x As Integer, c As New Collection
Randomize
Do While c.Count < 3
x = Int(51 * Rnd + 9)
If Cells(x, 3) = 1 Then
    On Error Resume Next
    c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
    If Err = 0 Then Cells(x, 3).Interior.ColorIndex = 3
End If
Loop
On Error GoTo 0
End Sub

bonne journée
@+

Edition : repositionné le "on error resume next"
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : prendre aléatoirement des cellules

Re

ci-dessous code commenté :

Code:
Option Explicit
Sub Test()
Dim x As Integer, c As New Collection
'Initialise le générateur de nombres aléatoires
Randomize
'boucle, tant que le nombre d'item de la collection est inférieur à 3
Do While c.Count < 3
'détermination d'un nombre aléatoire de 9 à 59
x = Int(51 * Rnd + 9)
'test si la cellule de la ligne déterminée par x est égale à 1
If Cells(x, 3) = 1 Then
    'empêche message d'erreur si la cellule à déjà été trouvé
    On Error Resume Next
    'utilisation d'une collection pour stocker les cellules trouvées
    c.Add Cells(x, 3).Address, CStr(Cells(x, 3).Address)
    'si pas d'erreur, on pourrait d'ailleurs se passe de ce test, coloriage de la cellule
    If Err = 0 Then Cells(x, 3).Interior.ColorIndex = 3
End If
Loop
'réinitialisation du gestionnaire d'erreur
On Error GoTo 0
End Sub

@+
 

mgrizzly

XLDnaute Junior
Re : prendre aléatoirement des cellules

Ok merci,
Mais à la place de colorier en rouge la cellule, est-ce qu'on ne pourrait pas mettre l'identifiant de la cellule coloriée dans la feuille "Mois en cours" colonne F ligne 4 par exemple?
 

Pierrot93

XLDnaute Barbatruc
Re : prendre aléatoirement des cellules

Re

modifie comme suit :

Code:
Option Explicit
Sub Test()
Dim x As Integer, c As New Collection
Randomize
Do While c.Count < 3
x = Int(51 * Rnd + 9)
If Cells(x, 3) = 1 Then
    On Error Resume Next
    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
End If
Loop
On Error GoTo 0
End Sub
 

mgrizzly

XLDnaute Junior
Re : prendre aléatoirement des cellules

Merci Pierrot,
Dernière petite question :
Ce code tire aléatoirement 3 cellules parmis celle qui ont un 1 dedans seulement il tire ces 3 cellules parmis les lignes de 9 à 59.
Je voudrais qu'il puisse en tirer 3 parmis les lignes 9 à 24, 3 parmis les lignes 25 à 41 et 3 parmis les lignes 42 à 59.
Il doit tirer ces 9 cellules en même temps;
Peux-tu m'aider ?
 

Pierrot93

XLDnaute Barbatruc
Re : prendre aléatoirement des cellules

Re

modifie la ligne ci-dessous en conséquence :

Code:
x = Int(51 * Rnd + 9)

par exemple pour 9 à 24 :

Code:
'24 - 9 + 1, te donne 16
x = Int(16 * Rnd + 9)

Touche F1, une fois ton curseur positionné sur le mot "rnd" te donnera plus d'info sur la fonction...

@+
 

mgrizzly

XLDnaute Junior
Re : prendre aléatoirement des cellules

Non, c'est pas ça, j'ai compris que ça doit donner
x= Int(16 * Rnd + 9)
x= Int(17 * Rnd + 25)
x= Int(18 * Rnd + 42)
C'est pour savoir où il faut le mettre dans le code, si on peut mettre les 3 en même temps.
J'ai essayé ça mais s'en succès !

Option Explicit
Sub Test()
Dim x As Integer, c As New Collection
Randomize
Do While c.Count < 3
x= Int(51 * Rnd + 9)
y= Int(17 * Rnd + 25)
z= Int(18 * Rnd + 42)
If Cells(x, 3) = 1 Then
On Error Resume Next
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
End If
If Cells(y, 3) = 1 Then
On Error Resume Next
c.Add Cells(y, 3).Address, CStr(Cells(y, 3).Address)
If Err = 0 Then
With Sheets("Mois en cours").Range("F4")
.Value = .Value & Cells(y, 3).Address(0, 0) & vbLf
End With
End If
End If
If Cells(z, 3) = 1 Then
On Error Resume Next
c.Add Cells(z, 3).Address, CStr(Cells(z, 3).Address)
If Err = 0 Then
With Sheets("Mois en cours").Range("F4")
.Value = .Value & Cells(z, 3).Address(0, 0) & vbLf
End With
End If
End If
Loop
On Error GoTo 0
End Sub
 

Pierrot93

XLDnaute Barbatruc
Re : prendre aléatoirement des cellules

Re

Essaye ainsi, mais tu aurais fourni toutes les données du problème, nous aurions gagné du temps....

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

XLDnaute Junior
Re : prendre aléatoirement des cellules

Merci Pierrot c'est super ce que tu as fait.
Désolé si je fourni pas toutes les données en même temps
mais ça me vient petit à petit !
Est-ce qu'il serait possible de dire au programme de ne pas prendre les cellules colorées en rouge ?
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 423
Membres
103 206
dernier inscrit
diambote