XL 2010 VBA - CODE Trés long - optimisation

[max.lander]

Bonjour,

j'essaye d'afficher depuis une feuille qui sert de base de donnée un planning
Mais l'exécution est vraiement très lente

Le code compare le numéro de semaine saisi et la base de données avec la procédure Load_Opérateurs.
Si le test est vrai il charge en colonne A l'opérateur (j'utilise un dictionnaire pour filtrer et n'afficher qu'une fois l'opérateur)

Public Sub Load_Opérateurs()
Set mondico = CreateObject("Scripting.Dictionary") 'Initialisation du dicionnaire mon dico

Sheets("Planer").Range("A67:A103").Value = ""

Set Tableau_WPL = Feuil2.UsedRange
'Ajout des prestatires et des permanents pour qu'ils ne soit pas ajouter au tableau plus bas



x = 66

       For i = 1 To Sheets("Base WPL").Range("A" & Rows.Count).End(xlUp).Row
     
    
            If Tableau_WPL(i, 6) = Sheets("planer").Range("B4").Value Then
   
            Opérateur = Tableau_WPL(i, 1)
   
                 If Not (mondico.Exists(Opérateur)) Then     'Pour eviter les doublons, si la donnée n'existe pas encore dans le dictionnaire on l'ajoute au dictionnaire et au tableau
                                                ' on utilise cette methode de façon detournée pour alimenter le Tableau
                     x = x + 1
                     mondico.Add Opérateur, Opérateur
                     ReDim Tableau(1 To mondico.Count)
                     Tableau(mondico.Count) = Opérateur
                     Sheets("Planer").Cells(x, 1).Value = Opérateur

    
              End If
        
                  End If
                
        Next i
     
      
End Sub

Ensuite se déclenchement un évenement pour colorer une partie du texte (celle entre parenthèse) et ajouter une formule au planning.

Private Sub Worksheet_Change(ByVal Target As Range)

' Mise en forme cellule des temporaire --> ROUGE

If Not Application.Intersect(Target, Range("A57:A103")) Is Nothing And Target.Count = 1 Then
lg = Target.Row

For Each c In Range("c" & lg & ":I" & lg)
On Error Resume Next
        c.Font.ColorIndex = 1
        c.FormulaArray = _
         "=IFERROR(INDEX(Horaires_WPL,MATCH(1,(Opérateur_WPL=RC1)*(Journées_WPL=R55C),0)),"""")"


       x = InStr(c, "(")
        y = InStr(c, ")")
        c.Value = Left(c, x - 2) & Chr(10) & Right(c, Len(c) - x + 1)
        c.Characters(x, y).Font.ColorIndex = 3
    Next c
    End If

End Sub

Toutes les idées pour améliorer sont les bienvenues.

Merci,

 

[pierrejean]

Bonjour max.lander
En règle générale les formules et le Vba ne font pas bon ménage

Vois si cela te convient
NB: J'ai conservé les formules de la colonne B

 

[gosselien]

Bonjour,

une tentative ici

P.

edit : oups pas vu la réponse de pierrejean

 

[max.lander]

Salut à tous,

Pierrejean, Gosselien merci pour votre aide celà fonctionne parfaitement !
Le temps d'éxecution n'a plus rien à voir !


Je pense que je vais conserver le code proposé par PierreJean car il englobe la mise en forme.

J'ai une dernière petite demande, en conservant le code de PierreJean, je souhaite exclure de l'affichage 4 noms systématiquement même s'ils existent en base (exemple: Lionel POL, Alexandra LAMY, Cédric M, Yohann GOURGUFF)

Une idée sur la question ?


Merci,

 

[pierrejean]

Re

Vois si cela te convient
Les Noms sont a inclure dans la macro mais il est tout a fait possible de demander a la macro d'aller les chercher ailleurs

 

[max.lander]

Pierrejean c'est totalement ça !
Merci beaucoup !