Optimisation code

[GGPS58]

Bonjour à tous le forum.
J'ai fais pas mal de recherches sur ce forum sans trouver de véritable réponse à ma question.
J'ai un tableau qui fait environ 100 lignes et 800 colonnes.
Pour chaque ligne je dois tester si les cellules correspondent à une cellule de référence.
J'ai donc créé un code qui me convenait parfaitement quand mon tableau était plus petit. Mais comme ce dernier a énormément grossi, le temps de mise à jour devient problématique.
Auriez-vous quelques conseils pour l'optimisation de mon code ?

Nota : Je joins un fichier d'illustration avec moins de lignes et colonnes.
La macro se lance depuis le bouton en feuille "MILESTONE" et le résultat est sur la feuille "INOUT"
Le code est similaire à mon vrai fichier.

D'avance merci de vos conseils.

 

[Compte Supprimé 979]

Bonjour GGPS58,

Commence déjà par m'enlever tous tes "Select"
Essaye ce code, pour commencer

Sub Phase_in_out() 'mise à jour planification
  Dim J As Integer 'Date flottante
  Dim L As Long 'Première ligne vide dans la feuille "MILESTONE" avant remplissage
  Dim N As Long 'Première ligne vide dans la feuille "INOUT" avant remplissage
  Dim ShtI As Worksheet
  Dim ShtM As Worksheet
  ' Désactiver le recalcul et les évènements
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  ' Définir les objets feuilles sur lesquelles on travaille
  Set ShtI = ThisWorkbook.Sheets("INOUT")
  Set ShtM = ThisWorkbook.Sheets("MILESTONE")
  'Mise à jour de la feuille PHASE INOUT
  'Nettoyage de toutes les lignes avant mise à jour
  ShtI.Rows("7:15").Delete
  '
  For L = 3 To ShtM.Range("A11").End(xlUp).Row
    N = ShtI.Range("A15").End(xlUp).Row + 1
    ShtI.Range("A2:BD2").Copy Destination:=ShtI.Range("A" & N)
    ShtI.Rows(N).RowHeight = 12.75
    ShtI.Range("A" & N).Value = ShtM.Range("A" & L).Value
    
    For J = 3 To 81
      If ShtI.Cells(3, J) >= ShtM.Range("B" & L).Value And ShtI.Cells(3, J) < ShtM.Range("C" & L).Value Then
        ShtI.Cells(N, J) = 1
        With ShtI.Cells(N, J).Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorDark1
          .TintAndShade = -0.249946592608417
          .PatternTintAndShade = 0
        End With
      End If
      If ShtI.Cells(3, J) >= ShtM.Range("C" & L).Value And ShtI.Cells(3, J) < ShtM.Range("D" & L).Value Then
        ShtI.Cells(N, J) = 2
        With ShtI.Cells(N, J).Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent4
          .TintAndShade = 0.399945066682943
          .PatternTintAndShade = 0
        End With
      End If
      If ShtI.Cells(3, J) >= ShtM.Range("D" & L).Value And ShtI.Cells(3, J) < ShtM.Range("E" & L).Value Then
        ShtI.Cells(N, J) = 3
        With ShtI.Cells(N, J).Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent5
          .TintAndShade = 0.399945066682943
          .PatternTintAndShade = 0
        End With
      End If
      If ShtI.Cells(3, J) >= ShtM.Range("E" & L).Value And ShtI.Cells(3, J) < ShtM.Range("F" & L).Value Then
        ShtI.Cells(N, J) = 4
        With ShtI.Cells(N, J).Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent2
          .TintAndShade = 0.399945066682943
          .PatternTintAndShade = 0
        End With
      End If
    Next J
  Next L
  ' Effacer les variables bojet
  Set ShtI = Nothing: Set ShtM = Nothing
  ' Réactiver le recalcul et les évènements
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

A+

 

[GGPS58]

Merci Bruno M45
Je regarde cela et vais essayer d'estimer mon gain de temps.
Je vous tiens au courant d'ici demain

 

[GGPS58]

Bonjour à tous,
J'ai donc pu tester les modifications proposées par BrunoM45.
Cela fonctionne plutôt bien, le gain de temps est de 50 % environ.
Je vais cependant continuer mes recherches pour réduire encore car le temps est encore très long sur mon tableau le plus complet.
Je suis donc preneur de vos conseils éventuels.

Bonne journée