Accélération d'une macro couleur

Accélération d'une macro couleur - VB/VBA/VBS - Programmation

Marsh Posté le 17-07-2010 à 11:08:05    

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
 
 

Reply

Marsh Posté le 17-07-2010 à 11:08:05   

Reply

Marsh Posté le 17-07-2010 à 12:36:10    

Salut, un code plus propre ,sans select ni l'immonde Goto


Option Explicit
 
Sub ColorCase()
Dim i As Long
Dim LastRow As Long, v As Long
 
    With Application
        .StatusBar = ""
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
     
    LastRow = Feuil1.Range("D" & Rows.Count).End(xlUp).Row
     
    For i = 4 To LastRow
        v = Feuil1.Range("D" & i)
        If v = 1 Then Feuil1.Range("D" & i).Interior.Color = 255
        If v = 2 Then Feuil1.Range("D" & i).Interior.Color = 65535
        If v = 3 Then Feuil1.Range("D" & i).Interior.Color = 5296274
        'etc .....
    Next i
     
    With Application
        .Calculation = xlCalculationAutomatic
        .StatusBar = "Maj terminée"
        .ScreenUpdating = True
    End With
End Sub


Message édité par kiki29 le 17-07-2010 à 12:50:14
Reply

Marsh Posté le 21-07-2010 à 18:52:18    

ok merci je vais tester! Je sais que le goto est immonde mais je ne connais pas d'autre fonctions qui m'envoie comme ca à un point bien précit de la macro c'est tout!

Reply

Marsh Posté le 22-07-2010 à 00:12:02    

Re, ce "style" de programmation est connue sous le nom de programmation spaghetti , voir http://fr.wikipedia.org/wiki/Programmation_spaghetti et le Goto++


Message édité par kiki29 le 22-07-2010 à 00:20:24
Reply

Marsh Posté le 25-07-2010 à 12:28:40    

La mise en forme conditionnelle ne serait-elle pas plus adaptée à une macro dans ce cas de figure ?


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed