Tirage au sort dans une petite plage
Bonjour a tous, forum bonjour
Je souhaiterai svp apporter un complément a mon programme par une petite macro sub pour
effectuer un tirage au sort a partir de chiffres situer dans une plage C1:V20.
Voir svp ci joint le fichier avec les explications dans une bulle.
Merci a vous pour votre aide, une bonne journée et bon w-end a vous.
Cordialement Raymond
Bonjour,
Une précision serait nécessaire :
effectuer un tirage au sort a partir de chiffres situer dans une plage C1:V20.
Il y a deux façons de traduire ton propos :
- soit on tire parmi les nombres figurant dans la plage, le tirage de chaque nombre différent de cette plage étant équiprobable (chacun a les mêmes chances d'être retenu)
- soit on tire toujours parmi les nombres figurant dans la plage, mais les chances de chacun sont proportionnelles au nombre de fois où il apparaît dans la plage (plus il apparaît, plus il aura de chances d'être tiré).
Il conviendrait de choisir entre ces deux types de tirages.
Cordialement.
Salut Mferrand
Merci pour ta réponse c'est sympa
sauf erreur il semblerai que ta première proposition soit la meilleure mais je connais pas les tirages au sort
aussi je m'en réfère a ton savoir
- soit on tire parmi les nombres figurant dans la plage, le tirage de chaque nombre différent de cette plage étant équiprobable (chacun a les mêmes chances d'être retenu)
On peut déjà faire cet essai
merci a toi vu l'heure un bon app
cdlt Ray
Procédure :
Sub Tirage7()
Dim d As Object, k, chk$, n%, i%, c As Range
Set d = CreateObject("Scripting.Dictionary")
With Worksheets("Feuil1")
For i = 1 To 20
If .Cells(i, 3) <> "" Then
n = n + 1
Else
Exit For
End If
Next i
If n = 0 Then Exit Sub
For Each c In .Range("C1:V" & n)
k = ChrW(c.Value + 32): d(k) = ""
Next c
For Each k In d.keys
chk = chk & k
Next k
k = "": Randomize
For i = 1 To Len(chk)
n = Int(Len(chk) * Rnd + 1)
k = k & Mid(chk, n, 1)
chk = Replace(chk, Mid(chk, n, 1), "")
Next i
For i = 1 To 7
n = Int(Len(k) * Rnd + 1)
chk = chk & Mid(k, n, 1)
k = Replace(k, Mid(k, n, 1), "")
Next i
k = ""
For i = 1 To 7
k = k & ";" & AscW(Mid(chk, i, 1)) - 32
Next i
k = Split(k, ";")
For i = 1 To 6
For n = i + 1 To 7
If CInt(k(n)) < CInt(k(i)) Then
k(0) = k(n): k(n) = k(i): k(i) = k(0)
End If
Next n
Next i
n = 1
For i = 1 To 20
If .Range("AK" & i) <> "" Then
n = i + 1
Else
Exit For
End If
Next i
If n > 20 Then
MsgBox "Le tableau de tirage des grilles est plein.", vbInformation, "Tableau plein"
Exit Sub
End If
With .Range("AK" & n)
For i = 1 To 7
.Cells(1, i) = CInt(k(i))
Next i
End With
End With
End SubTu la traouveras dans Module1. Elle est affectée au bouton prévu.
Méthode utilisée :
- Délimitation de la plage utilisée dans C1:V20
- Parcours de cette plage pour prélever les numéros sans doublons (utilisation Dictionary à cette fin)
- les numéros sont transformés en caractères texte en partant du caractère 33 (pour éliminer les caractères de contrôles et l'espace), il y a correspondance de chaque numéro avec un caractère
- L'ensemble des caractères correspondant aux numéros est rassemblé en une chaîne texte unique
- Après initialisation du générateur de nombres aléatoires, un premier tirage est effectué sur cette chaîne : on tire à chaque fois un caractère, on le transfère dans une autre chaîne, on le retire de la première avant de procéder au tirage suivant (cette méthode élimine d'emblée toute possibilité de doublon, ce premier tirage équivaut à mélanger les numéros prélevés dans la plage avant de passer au tirage final des numéros à retenir pour la grille)
- On enchaîne avec un tirage de 7 caractères destinés à composer la grille (extraits de la chaîne mélangée...)
- cette chaîne finale tirée donne lieu à reconversion des caractères en numéros entre lesquels on intercale un séparateur, ce qui permet d'obtenir un tableau des numéros tirés
- Ce tableau de numéros est trié dans l'ordre croissant
- On recherche alors la ligne sur laquelle doit être inscrite la ligne de numéros tirés (si le tableau est plein, cela est signalé et la proc. s'interrompt)
- Les numéros tirés sont affectés sur la première ligne disponible du tableau des grilles...
Cordialement.
Salut Mferrand,
Merci beaucoup pour le code alors ca fonctionne bien comme souhaiter,
et merci aussi pour toutes ces explications.
Serait t'il possible svp de savoir dans la plage AK1:AK20 combien de fois qu'a été tirer un nombre
Afficher cellule AK21 afficher le (nombre) qui est le plus sorti
Afficher cellule AK22 afficher le nombre de fois
par exemple au premier tirage 1-7-12-24-25-44-70
- ------puis au deuxième tirage 5-7-14-28-29-64-68
- ------puis au troisième tirage 1-7-11-21-22-61-70
------Cellule AK21--------------1-7-0--0--0----0--70
------Cellule AK22 -------------2-3-0--0--0----0--2
le 1 sorti deux fois
le 7 sorti trois fois
le 70 sorti deux fois
Merci pour ton aide et si je gagne pas avec ça c'est que je n'ai vraiment pas de chance.
Cdlt ray
Pas compris ce que tu veux ?
Salut Mferrand
Merci pour ta réponse
Voir svp le fichier ci-joint avec les explications dans une bulle.
plus simple qu'un long discours dit t'on
Merci a toi pour ton aide, bon début de semaine.
Cdlt Ray
Bonjour,
Formules :
AK22:
=MAX(NB.SI(AK1:AK20;AK1:AK20))AK21:
=INDEX(AK1:AK20;EQUIV(AK22;NB.SI(AK1:AK20;AK1:AK20);0))Formules matricielles.
Cordialement.
Salut Mferrand
Merci beaucoup pour les formules, c'est que j'ai chercher hier pendant un bon moment.
Bon, ca fonctionne très bien en tout cas, grand merci a toi.
Serait t'il svp possible de mettre en rouge.
Exemple dans la colonne AK
il y a 3 fois le chiffre (1) de mettre ce chiffre en rouge.
et idem pour les autres colonnes.
Je te remercie pour ton aide.
Cdlt Ray
Sans doute avec une MFC...
Salut Mferrand
Merci pour la réponse
Les MFC j'ai déjà essayer mais je merdouille trop, tout comme l'enregistreur de macro.
Pourtant j'y ai passer du temps mais a chaque fois ca ne corresponds pas a ce je veux faire
ca plante et tout le toutime bref
Merci pour les MFC je ni avais pas penser, évidemment
Bonne journée, bonne après midi a toi
Cdlt Ray
Re salut Mferrant
Après avoir bosser et chercher un bon moment cette après midi sur les MFC
je craque, on pourrai svp faire ca en vba a propos de ma dernière demande.
je suis plus sur de pouvoir bricoler vba que les MFC
Merci pour ton aide
Cdlt Ray
Ta MFC...
Salut Mferrand
Merci pour la MFC ca fonctionne comme souhaiter
Je te souhaite un bon W-end et une bonne soirée et encore merci
Cdlt Ray