Accélération d'une macro couleur - VB/VBA/VBS - Programmation
Marsh Posté le 17-07-2010 à 12:36:10
Salut, un code plus propre ,sans select ni l'immonde Goto
|
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!
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++
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 ?
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