Bonjour,
 
Je me débrouille un peu en VBA, et j'ai créé un programme que en fonction du chiffre lui associe une couleur.
Le programme en lui même fonctionne mais est extrêmement long parfois plus de 45 minutes (temps moyen 20 min)!
J'aimerai essayer de raccourcir au maximum ce temps.
La description du programme est simple, s'il tombe sur un 1 il met du rouge sur un 2 du jaune et sur un 3 du vert.
Ces chiffres sont disposé aléatoirement en fonctions des données que j'ai calculées à coté.
Ces chiffres se trouvent dans la colonne D à partir de la case N°4, leur étendue est variable (en moyenne 400 cellules) donc j'ai un fait une ligne de test en fin de macro pour vérifier que la case contient un numéro, si oui il passe à la cellule du dessous et il refait la macro sinon il s'arrête.
 
La macro fonctionne très bien mais  est trop longue en temps d'exécution.
voici la macro et merci à tous ceux qui pourront me donner un coup de main!!
 
Sub ColorCase()
'
' ColorCase Macro
'
' Touche de raccourci du clavier: Ctrl+s
'
Dim Cc As Integer
Dim y As Integer
 
Cc = MsgBox("Souhaitez-vous mettre de la couleur?", vbYesNo, "couleur" )
    Select Case Cc
        Case vbYes
            GoTo 3
        Case vbNo
            Exit Sub
        Case Else
            Exit Sub
3
y = 4
1
Cells(y, 4).Select
        If Selection.Value = 1 Then
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
        If Selection.Value = 2 Then
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
        If Selection.Value = 3 Then
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 5296274
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
     
  '  avance d 'une case
         y = y + 1
        Cells(y, 4).Select
            If Cells(y, 4) = "" Then GoTo 2 Else GoTo 1
             
2
        MsgBox ("Programme couleur terminé" )
 
    End Select
End Sub