Tirage aléatoire sans doublons
Bonsoir à tous,
J'essaye de mettre en place un tirage aléatoire, en "cascade" sans doublons.
J'ai mis les infos dans le fichier exemple.
Des idées ?
Merci d'avance
Bonsoir,
pour une de vos question : #Ref! c'est du au fait que INDEX n'a que 13 ligne A2:A14, donc entre borne 1;13 et non 2;14.
@ bientôt
LouReeD
c'etait aleatoire entre 1 et 13 et ne pas 2 - 14
Bonsoir,
Voici le fichier avec un code VBA pour tirage aléatoire des valeurs alphanumérique, puis tirage aléatoire des chiffres sans doublon :
Le déclenchement du code se fait par l'événementiel "Calculate" de la feuille, donc pour le déclenchement j'ai ajouté une fonction Aléa qui ne sert à rien
@BsAlv, en effet comme je disais il fallait modifier 2-14 par 1-13 !
@ bientôt
LouReeD
@LouReeD, avec un écart de 10 minutes la même réponse, oui, donc cela devait être correct, mais je n'avais pas vu ta réponse, sorry.
Pour être complet, une solution uniquement pour excel2021-365
=INDEX(Tableau1;INDEX(UNIQUE(TABLEAU.ALEA(13^2; 1; 1;13; 1));SEQUENCE(3));SEQUENCE(;2))Bonjour à tous les deux,
Merci LouReeD pour ce code VBA qui dépasse "déjà" mes compétences
Je ne peux malheureusement pas tester ta formule BsAlv
Bonjour
@BsSlv, je crois en effet sue j'ai un problème de transparence de mes messages !
Parcontre les UNIQUE et SEQUENCE et bien d'autres fonctions, devraient perdre la leur à mes yeux ! Encore de l'apprentissage à venir si le temps et le coeur m'en dit !
JB_ pour ce qui est du code il n'est pas optimisé n'y même evolutif automatiquement, alors faut voir... Il a le mérite de fonctionner, mais peut mieux faire !
@ bientôt
LouReeD
@LouReed, sorry de dire sorry
optimisé et evolutif
Dim Res
Sub Tirage()
nombre = 3 'combien de valeurs voulez-vous ?
Optimisé nombre
Range("F15").Resize(Application.Min(nombre, UBound(Res)), UBound(Res, 2)) = Res
End Sub
Sub Optimisé(nr)
a = Sheets("feuil1").ListObjects("Tableau1").DataBodyRange.Value 'les données
arr = WorksheetFunction.RandArray(UBound(a)) 'array avec valeurs aleatoires
Set dict = CreateObject("scripting.dictionary") 'cahier de brouillon
For i = 1 To Application.Min(UBound(a), nr)
r = Application.Match(WorksheetFunction.Small(arr, i), arr, 0) 'unique random integer
dict.Add dict.Count, Application.Index(a, r, 0) 'ajouter ligne correspondante au dictionary
Next
If dict.Count = 1 Then dict.Add dict.Count, Application.Index(a, r, 0) 'probeme avec dictionary avec un seul record
Res = Application.Index(dict.items, 0, 0)
End SubComment je fais pour actionner la macro ?
(J'ai une erreur d’exécution)
Est-ce que ce serait plus facile de faire :
Clique sur un bouton / tirage aléatoire du nom / tirage aléatoire du n°
Supprimer la ligne correspondante dans le tableau source (pour éviter un doublon de n°)
Clique sur un bouton / tirage aléatoire du nom / tirage aléatoire du n°
Supprimer la ligne correspondante dans le tableau source (pour éviter un doublon de n°)
Et ainsi de suite ?
Je ne sais pas ce n'est qu'une supposition
re,
l'erreur d'exécution, c'est de nouveau votre version moins récent
Lancer le macro = CTRL+l oubien le bouton vert oubien ALT+F8 et choisir "tirage"
Au secours
re,
je n'ai aucune idée, 2 essais en rouge et si cela ne marche pas, est-ce que vous pouvez ajouter votre dernier fichier entier ici ?
(Il s'arrête maintenant sur la ligne rouge avec x= ... ou la ligne suivante ? Ici, tout passe bien
Sub Optimisé(nr)
Dim arr(), i As Double
a = Sheets("feuil1").ListObjects("Tableau1").DataBodyRange.Value 'les données
On Error Resume Next
arr = WorksheetFunction.RandArray(UBound(a)) 'array avec valeurs aleatoires, seulement pour 2021-365
On Error GoTo 0
If Err.Number = 0 Then 'des versions qui ne connaissent pas randarray
ReDim arr(1 To UBound(a), 1 To 1)
For i = 1 To UBound(arr): arr(i, 1) = [Rnd]: Next 'pour des versions moins récents
End If
Set dict = CreateObject("scripting.dictionary") 'cahier de brouillon
For i = 1 To Application.Min(UBound(a), nr)
x = WorksheetFunction.Small(arr, i)
r = Application.Match(WorksheetFunction.Small(arr, i), arr, 0) 'unique random integer
dict.Add dict.Count, Application.Index(a, r, 0) 'ajouter ligne correspondante au dictionary
Next
If dict.Count = 1 Then dict.Add dict.Count, Application.Index(a, r, 0) 'probeme avec dictionary avec un seul record
Res = Application.Index(dict.items, 0, 0)
End Sub
Re bonjour à tous !
Je ne vous avais pas abandonné, la nuit m'a porté conseil
J'ai donc trouvé une solution... Avec mon petit langage M
Je vous laisse découvrir la requête, rien de bien compliqué finalement...
J'ai ajouté un bouton qui permet de rafraichir les résultats. Mais... je refais appel à vous pour du VBA, plus simple j'imagine et à ma portée cette fois, enfin j'espère :
L'idée serait de lancer le rafraichissement de la feuille tourné en boucle (avec un bouton GO par exemple) : un peu comme si on appuyait pleins de fois sur le bouton actualisé.
Puis, un autre bouton qui me permettrait d'arrêter la macro.
Est-ce que ça vous semble possible ?
Je vous remercie pour vos 2 propositions que je garde dans un coin bien évidemment
Ci-joint le fichier
cela fonctionne, mais je ne connais rien de cette language.
succes,
Bart
RE,
Ce n'est pas du langage M du coup. Mais bien du VBA.
Ce que je veux faire c'est activer, à l'aide d'un bouton, ce code VBA :
Public Sub Refresh_query()
ThisWorkbook.RefreshAll
End Sub(Qui permet l'actualisation de la feuille) de manière à ce que l'actualisation tourne en boucle. Les données du tableau se mettraient donc à changer... (comme si tu appuyait plusieurs fois sur le bouton que j'ai crée).
Puis pouvoir arrêter cette actualisation à l'aide d'un autre bouton.
Bonsoir
le fichier :
avec le bouton "Allons y !" de LouReeD !
@ bientôt
LouReeD
"la précision est au millième de seconde 0.001"
il montre millisecondes, mais la présicion est beaucoup moins , 50-100 milliseconde, le reste est "show"
En effet, j'ai mis cette boucle avant de décocher "arrière plan" du coup cette boucle ne sert presque plus à rien, mais il faut la laisser afin d'avoir une réaction sur le bouton "Allons y !" adéquate, sinon il faut cliquer "à mort" pour tomber au bon moment !
L'ajustement de la valeur de la temporisation fera que le clic sera pris "instantanément" ou pas.
Oui j'ai oubliais de le dire un clic sur le bouton ça part en boucle un autre clic ça s'arrête !
@ bientôt
LouReeD
Un grand merci LouReeD, c'est parfait ! Bravo
C'est vrai que plus je réduis le temps d'actualisation et plus c'est compliqué d'arrêter la macro.
J'ai du travail, car le code ne me parait pas compliqué et pourtant j'ai du mal à assimiler. Merci pour les commentaires !
Je crois avoir fait le tour de mes demandes pour ce sujet, y'a plus qu'a mettre tout ça bien forme
A bientôt
Simplement merci pour votre retour !
@ bientôt
LouReeD