Tirage de cellules

Bonjour,

Je suis débutante en VBA, j'aurais besoin d'un code qui puisse prendre aléatoirement un nombre de cellules dans un tableau de 7 colonnes et 50 lignes de ma feuille 1 et les mette dans ma feuille 2 comme ceci : 9 cellules dans les colonnes A, B, C, D, E et 3 dans les colonnes F, G, H. Mais en remplissant ces colonnes de la feuille 2, les cellules prisent dans la feuille 1 ne doivent pas se répétées dans la feuille 2 : dans les cellules ABCDEFGH il ne peut pas y avoir 2 fois la même cellule.

Merci de m'aider.

Bonjour,

C'est pas la solution définitive mais une approche

dans une feuille tu sélectionnes un certain nombre de cellule est tu donnes le nom z_plage

tu copies la macro suivante et tu l'exécute.

Cette macro va mettre en rouge 9 cellules aléatoirement

macro :

Sub toto()

Dim tab1

Set tab1 = CreateObject("Scripting.Dictionary")

With Range("z_plage")

.Value = ""

.Interior.ColorIndex = xlNone

End With

For Each cell In Range("z_plage")

cpt = cpt + 1

tab1("C" & cpt) = cell.Row & "," & cell.Column

Next

nb = cpt

Randomize

For b = 1 To 9

nb = tab1.Count

item_number = Int((nb - 1) * Rnd + 1)

tmp = tab1.keys

cle = tmp(item_number)

tmp = tab1.Items

tmp1 = tmp(item_number)

l = Val(Split(tmp1, ",")(0))

c = Val(Split(tmp1, ",")(1))

With Cells(l, c)

.Value = b

.Interior.ColorIndex = 3

End With

tab1.Remove (cle)

Next

End Sub

Merci beaucoup pyrof de m'avoir répondu, est-ce que tu pourrais m'expliquer les lignes de ton code?

Voila avec les commentaires

Sub toto()
' defintion d'un tableau a accès direct
Dim tab1
Set tab1 = CreateObject("Scripting.Dictionary")
'------------------------------------------------------
'         efface la zone nommée z_plage
'------------------------------------------------------
With Range("z_plage")
    .Value = ""
    .Interior.ColorIndex = xlNone
End With
'------------------------------------------------------
'  memorisation des addreses des cellules de la plage
' avec la cle ="C" et numéro incrémental
' en data le numero de ligne et de colonne de la cellule
' avec comme séparateur la virgule
'------------------------------------------------------
For Each cell In Range("z_plage")
    cpt = cpt + 1
    tab1("C" & cpt) = cell.Row & "," & cell.Column

Next
'------------------------------------------------------
nb = cpt
Randomize
For b = 1 To 6   ' nombre de valeur aleéatoire
    nb = tab1.Count ' nombre d'élément dans le tableau(item)
    item_number = Int((nb - 1) * Rnd + 1) ' nombre aleatoire entre 1 et nb
    tmp = tab1.keys
    cle = tmp(item_number) ' donne la cle du tableau de l'item itme_number
    tmp = tab1.Items
    tmp1 = tmp(item_number) ' recupère ligne colonne de item du tableau
    l = Val(Split(tmp1, ",")(0)) ' récupération de la ligne
    c = Val(Split(tmp1, ",")(1)) ' récupération de la colonne
    ' mise en valeur de la cellule choisie
    With Cells(l, c)
        .Value = b
        .Interior.ColorIndex = 3
    End With
    tab1.Remove (cle) ' supprime la celuule choisie dans le tableau
    Cells(b, 10) = cle ' affichage pour information
Next
End Sub

Merci pour ces explications Pyrof.

Est-ce que tu pourrais me préciser où est l'instruction "si cellule déjà sélectionnée alors passer à la suivante".

En fait il n'y a pas ce test

Je créé une liste des cellules (tableau tab1) et je fais un rnd dans ce tableau, je supprime l'élément choisi dans ce tableau (tab1.Remove (cle)) et je refais le rnd.

L'élément supprimé ne pourra pas être choisi une seconde fois

Ah d'accord je n'avais pas tout saisie. Merci bien Pyrof, je vais de ce pas tester ce code!

Rechercher des sujets similaires à "tirage"