doevents vba

[asta22]

je veux appliquer la fonction doevents sur mon code mais ça n'a pas marché
que dois-je-faire ?
MON CODE :

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

Set dict_dispo = CreateObject("scripting.dictionary")
Set dict_NbPerm = CreateObject("scripting.dictionary")
Set dict_MoyParVille = CreateObject("scripting.dictionary")
Set dict_NbPermCMP = CreateObject("scripting.dictionary")

Sheets("Permanences samedi"). Activer
dl = Cells(Rows.Count, 1).End(xlUp).Row
Cells(2, 3 + NbSamedi + 2).Resize(dl, NbSamedi).ClearContents


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

For i = 2 To dl 'mémorise les dispo villes par
ville = Cells(i, 1).value
If Cells(i, coldispo).value = 1 And Cells(i, 1).value <> 0 Alors
nbperm = Cells(i, NbSamedi * 2 + 7) .value
dict_dispo(ville) = dict_dispo(ville) & " " & i
dict_NbPerm(ville) = dict_NbPerm(ville) & " " & nbperm
' Debug.Print (dict_dispo(ville)) 'RAS
DoEvents
End If
Next i

j = 1

Pour chaque ville Dans dict_dispo.Clés
dict_MoyParVille(ville) = Cells(60 + j, NbSamedi * 2 + 7).value
j = j + 1
DoEvents
Next ville

k = 0

Set dict_MoyParVille = SortDictionaryByValue(dict_MoyParVille)



For Each ville In dict_MoyParVille.Keys 'sélectionner les villes avec assez de disponibilités
ArrayListeVille = Split(dict_dispo(ville))
'Debug.Print (dict_dispo(ville ))
Si UBound(TableListeVille) >= 3 Alors
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)
DoEvents
End If
Next ville

For i = 1 To 3 'choisir les 3 villes avec le moins de perm par CMP
ArrayListeCMP = Split(tabville(i, 2))
nbperm = Split(tabville(i, 3 ))

For j = 1 To UBound(ArrayListeCMP) 'pour chaque CMP dispo
dict_NbPermCMP(ArrayListeCMP(j)) = nbperm(j)
Next j

Set dict_NbPermCMP = SortDictionaryByValue(dict_NbPermCMP) ' tri par nb perm

j = 1
For Each CMP In dict_NbPermCMP.Keys

If (i = 1 And j <= 3) Or (i > 1 And j <= 2) Then 
Cells(CMP, colselect) = 1 
j = j + 1 
Else 
Exit For 
DoEvents 
End If 
Next CMP 

dict_NbPermCMP.RemoveAll 

Next i 

dict_dispo .RemoveAll 
dict_NbPerm.RemoveAll 
dict_MoyParVille.RemoveAll 

Next semaine 'semaine suivante 

Set dict_dispo = Nothing 
Set dict_NbPerm = Nothing 
Set dict_MoyParVille = Nothing 
Set dict_NbPermCMP = Nothing
end sub

 

[BSALV]

je ne vois pas pourquoi vous utilisez "doevents" ici, les dictionaries sont vraiment rapide, donc c'est pas necessaire.
Quel est le problème ?

Si UBound(TableListeVille) >= 3 Alors

Remarque, je pensais que VBA etait purement anglais !
Cette ligne, est-elle correcte ?

 

[asta22]

re-bonjour
c'est IF plutôt, oui les dictionnaires sont rapides , mais le problème ils sont plus rapides par rapport les fonctions d'excel ,
mon code me permet d'affecter un planning en fonction de disponibilité
et la disponibilité est basée sur des fonctions d'excel , vba affecte des planning avant que la disponibilité soit à jour car elle dépend d'affectation de la dernière semaine
j'espère que c clair

 

[BSALV]

on peut avoir des problemes quand on copy des "shapes", mais je ne connais pas d'autres situations qui sont critiques à ce point là.
You have 4 "doevents", je pense que les 3 premiers n'ont pas de sens, le 4ième peut-être.
C'est là aussi, que vous pensez ?