Eviter répétition code

Bonjour tt le monde,

j'ai un code Vba qui me permet d'affecter le planning des samedis , mon souci c'est de trouver une méthode pour éviter la répétition du code 12 fois car je ferai le planning d'un trimestre.

est-ce qu'il est possible de faire un seul code pour le planning de 12 samedis ?

Bonsoir,

c'est ce code qu'il faut adapter ?

Sub planning()
    Dim tabville(6, 2)
    Randomize Timer
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    Range("d2").Resize(dl, 1).ClearContents
    Set dict = CreateObject("scripting.dictionary")
    For i = 2 To dl 'mémorise les dispo par villes
        ville = Cells(i, 2)
        If Cells(i, 11) = "1" Then
            dict(ville) = dict(ville) & " " & i
        End If
    Next i
    For Each ville In dict.keys 'sélectionner les villes avec assez de disponibilités
        numeroligne = Split(dict(ville))
        If UBound(numeroligne) >= 3 Then
            k = k + 1
            tabville(k, 1) = ville
            tabville(k, 2) = dict(ville)
        End If
    Next
    For i = 1 To k 'melange les villes candidates
        a1 = aleatoire(1, k)
        a2 = aleatoire(1, k)
        a = tabville(a1, 1): tabville(a1, 1) = tabville(a2, 1): tabville(a2, 1) = a
        a = tabville(a1, 2): tabville(a1, 2) = tabville(a2, 2): tabville(a2, 2) = a
    Next i
    For i = 1 To 3 'choisir 3 villes
        numeroligne = Split(tabville(i, 2))
        For j = 1 To 2 + IIf(i = 1, 1, 0) 'choisir 3 personnes première ville et 2 personnes pour chacune des 2 autres villes
            Do
                a = aleatoire(1, UBound(numeroligne))
            Loop Until Cells(numeroligne(a), 12) = ""
            Cells(numeroligne(a), 12) = "W"
        Next j
    Next i
End Sub
Function aleatoire(borne_inférieure, borne_supérieure)
    aleatoire = Int(Rnd() * (borne_supérieure - borne_inférieure + 1)) + borne_inférieure
End Function

Qu'elles sont les variables ? à quoi correspond elles ? Sur quelle feuille agit elle ?

@ bientôt

LouReeD

merci pour ton retour

la feuille c'est la 1 ère (planning)

les variables nom et villes sont fixes, disponibilité et selecte changent après chaque samedi

le code :

Sub planning()
Dim tabville(6, 2)
Randomize Timer
dl = Cells(Rows.Count, 1).End(xlUp).Row
Range("d2").Resize(dl, 1).ClearContents
Set dict = CreateObject("scripting.dictionary")
For i = 2 To dl 'mémorise les dispo par villes
ville = Cells(i, 2) ' les villes dans la colonne B
If Cells(i, 3) = "1" Then ' disponibilité colonne C mais pour le 1 week end après ça change; cells = "1" çàd que employé est disponible
dict(ville) = dict(ville) & " " & i
End If
Next i
For Each ville In dict.keys 'sélectionner les villes avec assez de disponibilités
numeroligne = Split(dict(ville))
If UBound(numeroligne) >= 3 Then
k = k + 1
tabville(k, 1) = ville
tabville(k, 2) = dict(ville)
End If
Next
For i = 1 To k 'melange les villes candidates
a1 = aleatoire(1, k)
a2 = aleatoire(1, k)
a = tabville(a1, 1): tabville(a1, 1) = tabville(a2, 1): tabville(a2, 1) = a
a = tabville(a1, 2): tabville(a1, 2) = tabville(a2, 2): tabville(a2, 2) = a
Next i
For i = 1 To 3 'choisir 3 villes
numeroligne = Split(tabville(i, 2))
For j = 1 To 2 + IIf(i = 1, 1, 0) 'choisir 3 personnes première ville et 2 personnes pour chacune des 2 autres villes
Do
a = aleatoire(1, UBound(numeroligne))
Loop Until Cells(numeroligne(a), 4) = "" ' affectation dans la colonne D
Cells(numeroligne(a), 4) = "W" ' W signifie que employé travaille le samedi
Next j
Next i
End Sub
Function aleatoire(borne_inférieure, borne_supérieure)
aleatoire = Int(Rnd() * (borne_supérieure - borne_inférieure + 1)) + borne_inférieure
End Function

bonjour,

voici

Bonjour,

un seul mot : Acide ! Je manque de temps en ce moment ! Merci @ vous pour cette reprise.
bravo à vous

@ bientôt

LouReeD

merci frère pour ton aide :)

Bonjour Loureed,

Merci @ vous pour cette reprise.

en fait il s'agit de la continuation d'une autre demande que j'avais traitée.

https://forum.excel-pratique.com/excel/tirage-au-sort-aleatoire-170245

J'aurais du y penser, tout ce qui touche aux planning "avec contraintes" vous n'êtes jamais bien loin !

@ bientôt

LouReeD

Bonjour :),

je veux ajouter une colonne pour les prénoms , mais mon code ne fonctionne plus, même si j'ai modifié le paramètre des colonnes

bonjour h2so4,

stp comment puis-je ajouter un message d'erreur si l'algo ne trouve pas de dispo !!!

car en cas d'indisponibilité , il attribue des permanences aux personnes indispo

merci d'avance

Bonsoir,

je ne comprend pas bien le code, mais l'idée serait "à l'endroit" où la désignation est faite de faire un test de disponibilité de ce qui s'appraite à être inscrit et si = indispo alors msgbox.

@ bientôt

LouReeD

ok merci

Bonsoir,

alors qu'est ce que cela donne ?

@ bientôt

LouReeD