Choix aléatoire d'une cellule dans Excel

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

pat01200

XLDnaute Occasionnel
Bonjour,

Voilà : Sur une feuille d'un classeur EXCEL, j'ai une liste de 100 cellules remplies (de A1 à J10) et j'aimerais, à partir d'un simple bouton, créer une macro qui me permettrait d'activer une de ces cellules, totalement au hasard et de changer de cellule à chaque nouveau clic et ce bien entendu sans retomber dans une cellule déjà choisie auparavant. Est-ce possible ? et si oui, quelqu'un aurait-il en stock le code d'une telle macro. Merci d'avance à toute personne pouvant me venir en aide...
 
Re : Choix aléatoire d'une cellule dans Excel

Bonjour Pat

regarde le code ci-dessous si il peut t'aider :

Code:
Option Explicit
Sub test()
Dim l As Byte, c As Byte, x As New Collection
Randomize
Do While x.Count < 100
    On Error Resume Next
    l = Int(10 * Rnd) + 1
    c = Int(10 * Rnd) + 1
    x.Add l & c, CStr(l & c)
    If Err.Number = 0 Then
        Cells(l, c).Select
        If MsgBox(Cells(l, c).Address & " trouvée !!!" & vbLf & "Continuez ???", vbYesNo) _
            = vbNo Then Exit Sub
    End If
Loop
End Sub

bonne soirée
@+
 
Dernière édition:
Re : Choix aléatoire d'une cellule dans Excel

Bonsoir,

Salut Pierrot

avec ce code, tu colories en rouge selon le tirage, dans la zone A1:J10

Le code :

Code:
Public MesCellules As Object
Sub tirag()
Dim X As Byte, Num As Byte
On Error Resume Next
If MesCellules.Count = 0 Then
On Error GoTo 0
Set MesCellules = CreateObject("Scripting.Dictionary")
End If
If MesCellules.Count = 100 Then Exit Sub
Do While X = 0
    Randomize (Timer)
    Num = Int((100) * Rnd + 10)
    If Not MesCellules.Exists(Num) Then
        X = 1
        MesCellules.Add Num, Num
    End If
Loop
If Num > 99 Then
    lig = Left(Num, 2): col = Right(Num, 1) + 1
Else
    lig = Left(Num, 1): col = Right(Num, 1) + 1
End If
Cells(lig, col).Interior.ColorIndex = 3
End Sub

Sub init()
On Error Resume Next
MesCellules.RemoveAll
Range("A1:J10").Interior.ColorIndex = 6
End Sub

un fichier exemple :
 

Pièces jointes

Re : Choix aléatoire d'une cellule dans Excel

Merci Pierrot,

Je viens de faire un grand pas, la macro fonctionnant très bien. Le seul problème, c'est qu'il y a des doublons (Activation d'une cellule déjà choisie auparavant)... mais je vais essayer de trouver une solution à ce problème, à moins que quelqu'un sur le forum l'aie.

Encore merci
 
Re : Choix aléatoire d'une cellule dans Excel

Bonjour,

perso pas détecté de doublon en utilisant mon code... testes comme ceci, normalement 100 cellules en rouge, si il y avait doublon certaines ne seraient pas en couleur... ou alors quelque chose m'échappe...

Code:
Option Explicit
Sub test()
Dim l As Byte, c As Byte, x As New Collection
Randomize
Do While x.Count < 100
    On Error Resume Next
    l = Int(10 * Rnd) + 1
    c = Int(10 * Rnd) + 1
    x.Add l & c, CStr(l & c)
    If Err.Number = 0 Then
        Cells(l, c).Select
        Cells(l, c).Interior.ColorIndex = 3
        'If MsgBox(Cells(l, c).Address & " trouvée !!!" & vbLf & "Continuez ???", vbYesNo) _
            = vbNo Then Exit Sub
    End If
Loop
End Sub

sinon tu peux aussi rempacer la ligne de code qui suit :

Code:
x.Add l & c, CStr(l & c)

par celle ci :

Code:
    x.Add "$" & l & "$" & c, CStr("$" & l & "$" & c)

bonne soirée
@+
 
Re : Choix aléatoire d'une cellule dans Excel

Merci beaucoup pour cette macro bhbh, elle est parfaite !... mais honte à moi, je me suis trompé dans mon énoncé : en fait je n'ai que 90 cellules situées de B1 à J10, la colonne A étant une colonne de titres (ces cellules ne devant donc pas faire partie des sélectionnables). J'ai bien essayé de modifié la macro jointe, mais sans succès (décidemment, je me trouve de moins en moins doué!!!)...
Vous serait-il possible de m'aider une fois de plus ???
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour