Microsoft 365 Aide pour insertion nombre aléatoire

[NONO14]

Bonjour à tous,

A l'aide d'un tuto trouvé sur internet, j'ai mis en place ce petit bout de code qui me permet de générer un nombre aléatoire compris entre 1 et 2000.
Ce nombre me sert à attribuer un code à des collaborateurs. Pour le moment, je génère ces nombre à partir d'un clique sur un bouton et celui-ci s'affiche dans une MsgBox.
Ce que je souhaiterai faire, si c'est possible, ce que le nombre généré se positionne en A2, le prochain en A3, etc...
Auriez-vous une idée de faisabilité ?
Merci par avance pour votre aide
Le code est placé dans un module

Sub Aleatoire()
    Randomize
        nombre_alea = Int((2000 * Rnd + 1))
MsgBox nombre_alea
End Sub

J'ai modifié le code ci-dessus qui me permet d'insérer le nombre en D2 de la feuille.
Mais je ne sais pas comment lui dire d'aller chercher la prochaine cellule vide ensuite, c'est-à-dire D3 et ainsi de suite

Sub Aleatoire()
    Randomize
        nombre_alea = Int((2000 * Rnd + 1))
Cells(2, 4) = nombre_alea
End Sub

 

[patricktoulon]

bonjour
ceci travaille avec la feuille active

Sub Aleatoire()
    Randomize
    nombre_alea = Int((2000 * Rnd + 1))
    ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1) = nombre_alea
End Sub

question:
doit on surveiller et ou excepter les doublons ?

 

[NONO14]

J'ai trouvé la solution. En cliquant sur le bouton, les nombres se mettent les uns en-dessous des autres dans ma colonne D (pas A comme écrit par erreur plus haut)
Voici le code :

Sub Aleatoire()
Dim R As Range
Set R = ActiveSheet.Columns("D").Find("", LookIn:=xlValues)
    Randomize
        nombre_alea = Int((2000 * Rnd + 1))
        If Not R Is Nothing Then R = nombre_alea
End Sub

 

[NONO14]

bonjour
ceci travaille avec la feuille active

Sub Aleatoire()
    Randomize
    nombre_alea = Int((2000 * Rnd + 1))
    ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1) = nombre_alea
End Sub

question:
doit on surveiller et ou excepter les doublons ?

Bonjour patricktoulon
Merci pour votre réponse. Le Randomize doit éviter les doublons ???
J'ai utilisé votre code qui est plus clair que le mien. Merci beaucoup

 

[patricktoulon]

re
punaise!!!
un find ,un rnd, un test is nothing sur une range
et tout ça sans garantir l'exception des doublons
et bien tu es bien parti là

en ce qui concerne ma proposition
et bien tu change "1" pour 4 ou "D" c'est tout
ma version
la localisation de la cellule est explicite
si tu veux excepter les doublons il faudra un peu plus pousser le travail(pas beaucoup)

Sub Aleatoire()
    Randomize
    nombre_alea = Int((2000 * Rnd + 1))
    ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1) = nombre_alea
End Sub

non le randomize n’évite pas les doublons il permet un recyclage plus large c'est tout

regarde avec un plus petit nombre
je prend 10 nombres aléatoires entre 1 et 10

Sub Aleatoire()
    For i = 1 To 10
        Randomize
        nombre_alea = Int((10 * Rnd + 1))
        ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1) = nombre_alea
        t = t & nombre_alea & " | "
    Next
    MsgBox t
End Sub

résultat comme tu le vois j'ai des doublons

 

[NONO14]

re
punaise!!!
un find ,un rnd, un test is nothing sur une range
et tout ça sans garantir l'exception des doublons
et bien tu es bien parti là

en ce qui concerne ma proposition
et bien tu change "1" pour 4 ou "D" c'est tout
ma version
la localisation de la cellule est explicite
si tu veux excepter les doublons il faudra un peu plus pousser le travail(pas beaucoup)

Sub Aleatoire()
    Randomize
    nombre_alea = Int((2000 * Rnd + 1))
    ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1) = nombre_alea
End Sub

non le randomize n’évite pas les doublons il permet un recyclage plus large c'est tout

regarde avec un plus petit nombre
je prend 10 nombres aléatoires entre 1 et 10

Sub Aleatoire()
    For i = 1 To 10
        Randomize
        nombre_alea = Int((10 * Rnd + 1))
        ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1) = nombre_alea
        t = t & nombre_alea & " | "
    Next
    MsgBox t
End Sub

résultat comme tu le vois j'ai des doublons
Regarde la pièce jointe 1202520

Merci pour cette éclairage. Du fait que je prospecte assez large, il y a peu de risque, mais sait-on jamais !
Par contre, je ne sais pas comment remédier à cela, mon niveau en Vba est plutôt bas.

 

[Dranreb]

Bonjour.
Fonction perso ListeAl,
Fonction perso Hasard,
Procédure perso utilisant un objet ListeAléat,
À votre choix.

 

[patricktoulon]

re

Sub Aleatoire()
    Dim C As Range, i&, Nombre_Alea&
     Randomize
re:
    Nombre_Alea = Int((2000 * Rnd + 1))

    Set C = ActiveSheet.[D:D].Find(Nombre_Alea, LookIn:=xlValues) 'on cherche la cellule ou se trouve le numero que l'on viens de tirer au sort

    If Not C Is Nothing Then GoTo re ' si la cellule n'est pas rien alors il a déjà été tiré on retire un autre nombre en retournant à l'étiquette "re:"

    ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1) = Nombre_Alea

End Sub

 

[NONO14]

Il y a bien cette discussion, mais je ne comprends pas grand chose

XL 2013 - crer une liste de nombres aleatoires entre un min et un max avec une fonction VBA méthode particulière

Bonsoir à tous c'est juste pour le fun perso pour créer une liste de nombres aléatoires je préfère mélanger une liste ordonné(dans l'ordre au départ) on a la garantie de non doublons et c'est largement plus rapide sauf que là l'exercice est encore plus intéressant je demarre avec une liste...

excel-downloads.com

 

[Dranreb]

La méthode Désordre de mon objet ListeAléat procède comme ça.
Sa méthode Init, ne procède plus ainsi.
Elle commence par mettre 1 au début et pour chaque autre à partir de 2 en réinitialise une position aléatoire parmi ceux déjà posés, dont la valeur est préalablement chassée à la fin.

 

[NONO14]

re

Sub Aleatoire()
    Dim C As Range, i&, Nombre_Alea&
     Randomize
re:
    Nombre_Alea = Int((2000 * Rnd + 1))

    Set C = ActiveSheet.[D:D].Find(Nombre_Alea, LookIn:=xlValues) 'on cherche la cellule ou se trouve le numero que l'on viens de tirer au sort

    If Not C Is Nothing Then GoTo re ' si la cellule n'est pas rien alors il a déjà été tiré on retire un autre nombre en retournant à l'étiquette "re:"

    ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1) = Nombre_Alea

End Sub

Merci beaucoup pour votre aide. Je teste (convaincu que ça va marcher) et je reviens vers vous.

 

[NONO14]

Au code ci-dessus donné par patricktoulon, j'aimerai y ajouter une condition, si cela est possible, désolé mais cela m'est apparu en testant. Voilà la condition, si je veux mettre un code en D2 mais que la cellule B2 est vide alors rien ne se passe. C'est pour éviter de générer un code inutilement, il est vrai qu'il est toujours possible de l'effacer.

 

[patricktoulon]

re
une petite version avec indexation et memo des le premier tirage
le premier tirage crée un array de nombre alea entre min et max et le mémorise
le choix de l'index est simplement le numéro de ligne
les tirage suivants on ne récupère que l'index puisque l'array alea est en mémoire
rigolo non ?

Function Aller_a_la_peche(min, max)
    Static tbl
    If Not IsArray(tbl) Then
        tbl = Evaluate("TRANSPOSE(ROW(" & min & ":" & max & "))")
        For i = LBound(tbl) To UBound(tbl)
            x = 1 + (Rnd * (max - 1))
            tp = tbl(i): tbl(i) = tbl(x): tbl(x) = tp
        Next
    End If
    Aller_a_la_peche = tbl
End Function


Sub test2()
    With ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1)
        .Value = Aller_a_la_peche(1, 2000)(.Row - 1)
    End With
End Sub

 

[NONO14]

re
une petite version avec indexation et memo des le premier tirage
le premier tirage crée un array de nombre alea entre min et max et le mémorise
le choix de l'index est simplement le numéro de ligne
les tirage suivants on ne récupère que l'index puisque l'array alea est en mémoire
rigolo non ?

Function Aller_a_la_peche(min, max)
    Static tbl
    If Not IsArray(tbl) Then
        tbl = Evaluate("TRANSPOSE(ROW(" & min & ":" & max & "))")
        For i = LBound(tbl) To UBound(tbl)
            x = 1 + (Rnd * (max - 1))
            tp = tbl(i): tbl(i) = tbl(x): tbl(x) = tp
        Next
    End If
    Aller_a_la_peche = tbl
End Function


Sub test2()
    With ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1)
        .Value = Aller_a_la_peche(1, 2000)(.Row - 1)
    End With
End Sub

Là ça devient un poil trop compliqué pour mon petit cerveau. Votre premier code fonctionne très bien alors je vais le conserver. Toutefois j'apprécie l'effort consenti pour m'aider.

 

[patricktoulon]

oui tout à fait cela dit on s'emballe tous
c'est justement ce que j'allais dire
mieux vaut commencer par un code que tu sera capable de comprendre
les autres versions de mes camarades et moi même ne sont pas à la porté de débutants
même si (il est vrai ) que nous proposons tous des méthodes avec sub d'appels simplifiée
presque pas l'a peine (sinon par curiosité) d'aller voir les codes des fonctions
nous les barbes à papa heu.... barbatruc, on a tendance a faire du zèle comme des jeunes premiers
en bombardant de réponses le demandeur ce qui a pour effet de voir apparaitre des goute sur son front

l'esprit de compétition (amicale bien sur ) n'y est pas pour rien non plus