Optimiser mon code

Bonjour,


mon code (module 1) que je veux optimiser



mon code distribue les permanences du samedi en fonction des disponibilités à travers un tirage aléatoire; je veux changer le tirage aléa par un tirage qui respecte l'équité entre les employés + l'équité entre les différentes villes(équipes), mais pour l'instant je vise seulement de respecter l'équité entre les employés(colonne AG)

j'ai crée 3 dictionnaires pour stocker la liste des :

-liste des employés dispo par ville
-liste des Nombres Permanences effectuées par les employés dispo par ville
- moyenne Nombres Permanences effectués par ville

Sub planning()
    Dim tabville(6, 4)
    'nom As String
    'nbr_perm As Integer
    Dim j As Integer
    Dim NbSamedi, minival As Integer
    NbSamedi = 13
    Dim dict_dispo As Object
    Dim dict_NbPerm As Object
    Dim dict_MoyParVille As Object
    Dim dict_NbPermCMP As Object

    Randomize Timer
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    For semaine = 1 To NbSamedi '13 semaines à traiter
        coldispo = semaine + 2 'numéro de colonne des dispos de la semaine
        colselect = coldispo + NbSamedi + 2  'numéro de colonne des personnes sélectionnées pour la semaine
        
        Cells(2, colselect).Resize(dl, 1).ClearContents
        
        Set dict_dispo = CreateObject("scripting.dictionary") 'dict avec liste des Num ligne des employés dispo par ville
        Set dict_NbPerm = CreateObject("scripting.dictionary") 'dict avec liste des Nb Perm effectuées par les employés dispo par ville
        
        For i = 2 To dl 'mémorise les dispo par villes
            ville = Cells(i, 1).Value
            If Cells(i, coldispo).Value = 1 And Cells(i, 1).Value <> 0 Then 'ville avec 0
                NbPerm = Cells(i, NbSamedi * 2 + 6).Value ' Nb perm effectué par le employés
                dict_dispo(ville) = dict_dispo(ville) & " " & i
                dict_NbPerm(ville) = dict_NbPerm(ville) & " " & NbPerm
            End If
        Next i
        
        Set dict_MoyParVille = CreateObject("scripting.dictionary") ' dict avec moyenne Nb Perm effectués par ville
        
        j = 1
        
        For Each ville In dict_dispo.Keys
            dict_MoyParVille(ville) = Cells(60 + j, NbSamedi * 2 + 6).Value
            j = j + 1
        Next ville

        k = 0
    
        SortDictionary dict_MoyParVille
    
        For Each ville In dict_MoyParVille.Keys 'sélectionner les villes avec assez de disponibilités
            numeroligne = Split(dict_dispo(ville)) 'tableau avec liste des employés dispo de la ville
            If UBound(numeroligne) >= 3 Then
                k = k + 1
                tabville(k, 1) = ville
                tabville(k, 2) = dict_dispo(ville)
                tabville(k, 3) = dict_NbPerm(ville)
                tabville(k, 4) = dict_MoyParVille(ville)
            End If
        Next ville



        'For i = 1 To 3 'choisir les 3 villes avec le moins de perm par employés

            numeroligne = Split(tabville(i, 2)) ' tableau, 1 colonne : liste des employés dispo dans la ville
            NbPerm = Split(tabville(i, 3)) ' tableau, 1 colonne : nb Perm effectué par ces employés
            Set dict_NbPermCMP = CreateObject("scripting.dictionary") ' dict avec 2 dimensions : Numeroemployé, NbPermEffectu
           
            For j = 1 To UBound(numeroligne) 'pour chaque employé dispo
                dict_NbPermCMP(j) = NbPerm(j) 'on complète le dict avec : numéro du employé, NbPermEffectué par celui-ci
            Next j
           
           SortDictionary dict_NbPermCMP ' tri par nb perm
           'selection des 3 premiers employés pour ville 1 et des 2 premiers CMP pour villes 2 et 3
                 numeroligne = Split(tabville(i, 2))
           
           For i = 1 To 3 'choisir 3 villes
           If j = 1 Then For j = 1 To 3 'dict_NbPermemployé(j) = numéro du employé à qui affectuer la perm
           If j > 1 Then For j = 1 To 2 'dict_NbPermemployé(j) = numéro du employé à qui affectuer la perm

             k = 0
'             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(NbPerm))
                 Loop Until Cells(NbPerm(a), colselect) = ""
                 Cells((NbPerm(a)), colselect) = "1"
             Next j
         Next i
    Set dict_dispo = Nothing
    Set dict_NbPerm = Nothing
    Set dict_MoyParVille = Nothing
    Next semaine 'semaine suivante
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

Sub SortDictionary(dict As Object)
    Dim i As Long
    Dim key As Variant

    With CreateObject("System.Collections.SortedList")
        For Each key In dict
            .Add dict(key), key
        Next
        dict.RemoveAll
        For i = 0 To .Keys.Count - 1
            dict.Add .Item(.GetKey(i)), .GetKey(i)
        Next
    End With
End Sub

EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

Merci d'y penser dans tes prochains messages.