Tirage au sort aléatoire

je veux modifier mon code pour qu'il soit flexible , si par exemple je veux tirer aléatoirement sur un range et non pas toute la ligne

mon objectif est de sélectionner 2 min ou 3 max de personnes disponible le week end :)

voilà mon code :

Sub planning()

Const LIMIT = 1000000 ' limit iterations to solve

Dim wb As Workbook, ws As Worksheet
Dim lastrow As Long
Dim dict As Object, key, bLoop As Boolean
Dim n As Long, x As Long, sType As String

Set dict = CreateObject("Scripting.Dictionary")
dict.Add "W", 7
dict.Add " ", 0

Set wb = ThisWorkbook
Set ws = wb.Sheets("planning")
bLoop = True
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("C2:C" & lastrow).Cells.Clear

Do While bLoop

' select random row
x = lastrow * Rnd() + 1
sType = Trim(.Cells(x, "B"))

' check if needed
If Len(.Cells(x, "C")) = 0 And dict(sType) > 0 Then
.Cells(x, "C") = "W"
dict(sType) = dict(sType) - 1

' check if finished
bLoop = False
For Each key In dict
If dict(key) > 0 Then bLoop = True
Next
End If

' avoid infinite loop
n = n + 1
If n > LIMIT Then
For Each key In dict.keys
Debug.Print key, dict(key)
Next
MsgBox "Too many iterations to solve", vbCritical, "limit=" & LIMIT
Exit Sub
End If
Loop
End With
MsgBox "Done in " & n & " iterations", vbInformation
End Sub

bonjour,

pour sélectionner 2 ou 3 personnes max, remplacer le 7 par 2 ou par 3 dans cette instruction.

dict.Add "W", 7

pour sélectionner un range, mettre le numéro de la dernière ligne dans lastrow au lieu de .cells(....) dans cette instruction

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

Bonjour,

merci pour votre réponse, je n'ai pas bien expliqué , du coup j'ai un ensemble des employés mais ils sont répartit sur plusieurs villes ( 6 au total)

je veux tirer aléatoirement 3 villes avec un tirage de 3,2,2 ou 2,2,3 ; l'essentiel de ne pas dépasser 7 au total mais tirer seulement 3 villes avec un quota min2 ou max 3

j'espère que j'ai bien expliqué ma contrainte

mon code initial me permet seulement de tirer aléatoirement 7 au total mais j'ai besoin de le modifier afin de respecter ma 2 contrainte

merci d'avance

re-Bonjour,

pas évident de répondre sans avoir une vue sur le fichier ... Mais je pense que ceci devrait fonctionner en gardant la même logique du code, qui n'est pas optimale.

remplace tes codes W en colonne B par un code indiquant aussi la ville par exemple WV1 (pour weekend-ville-1, etc ...).

puis complète/modifie cette partie du code

Set dict = CreateObject("Scripting.Dictionary")
dict.Add "WV1", 3 'weekend-ville 1
dict.Add "WV2", 3 'weekend-ville 2
dict.Add "WV3", 2 'weekend-ville 3
' etc ....
dict.Add " ", 0

les codes en colonne B doivent être les mêmes que ceux ajoutés dans le code

22classeur1.xlsm (18.69 Ko)

Merci pour ce classeur sans autre commentaire. (=je te mets le fichier débrouille-toi avec)

le code que tu as mis ne peut pas fonctionner sur ce classeur, la structure est différente. Ton code utilise les colonnes A à C ton classeur utilise les colonnes B,C,D et la colonne dans laquelle mettre le résultat n'est pas indiquée. Si tu suis mes instructions sur le fichier avec la structure correcte, cela fonctionnera.

sinon voici ton dernier fichier avec les adaptations nécessaires.

10classeur1-31.xlsm (19.78 Ko)

re-bonjour,

je m'excuse pour le mal entendu (j'ai commenté dans le fichier mais j'aurai écrit ), j'ai appliqué tes instructions mais malheureusement je trouve toujours des villes avec 1 personne (l'objectif est de sélectionner seulement 3 villes avec quota 3,2,2 ou 2,2,3)donc mon quota n'est pas respecté , j'ai rectifié le fichier au niveau des colonnes :

merci pour votre aide :)

8sam.xlsm (28.04 Ko)

re-bonjour,

ok, je vois que je n'ai rien compris à la demande, ni à la manière dont tu veux utiliser le fichier.

re-bonjour,

j'avoue que c'est un peu compliqué,

ma contrainte est la suivante :

j'ai 6 équipes chaque équipe présente une ville , mon objectif est de sélectionner seulement et aléatoirement 3 équipes chaque samedi et avec les quotas suivants 3,2,2 ou 2,2,3 l'essentiel que la somme des 3 équipes ne dépasse pas 7.

j'espère que c claire :)

re-bonjour,

voici une nouvelle version

13sam-1.xlsm (31.00 Ko)

merci beaucoup et bonne journée :)

re-bonjour,

je suis désolé pour le dérangement

j'ai besoin juste de modifier le code pour l'adapter au planning réel (onglet test) donc je dois changer les paramètres du colonne de chaque variable, j'ai essayé de modifier les paramètres de ville, nom , dispo, select mais ç'a n'a pas marché

voilà le fichier et merci encore une fois.

18sam-1.xlsm (64.98 Ko)

bonjour,

je t'ai mis des commentaires dans le fichier que je t'ai envoyé précédemment en indiquant les lignes à modifier potentiellement si les colonnes changent ou si le nombre de villes change.

19sam-1.xlsm (31.50 Ko)

merci :) je vais appliquer tes conseils

Bonjour H2SO4 et le forum,

j'ai modifié ton code pour l'adapter aux autres samedis , mais parfois je trouve un problème ("too many itéraions") après plusieurs répétitions du code,

ma question est-ce qu'il est possible d'éviter de répéter le code pour chaque samedi car j'ai 12 samedi au total ( je fais le planning d'un trimestre)

merci encore pour ton aide .

voilà le fichier actualisé

pour le code de vba module 1 ça veut dire 1 samedi

module 2 samedi etc.

j'espère qu'il y aura une solution de faire un seul code pour éviter cette répétition

12multi-sam.xlsm (37.15 Ko)
Rechercher des sujets similaires à "tirage sort aleatoire"