Bonjour à tous,
J'ai créé une macro qui sert à voir l'avancement d'un projet de facon visuel (colonne J - AC) sur 20 cellules en fonction du pourcentage entré en colonne G. Le problème est que le code prend trop de temps à exécuter. J'aimerais donc l'optimiser car je voudrais faire la validation sur 4000 lignes.
Voir fichier joint
Merci de votre aide
J'ai créé une macro qui sert à voir l'avancement d'un projet de facon visuel (colonne J - AC) sur 20 cellules en fonction du pourcentage entré en colonne G. Le problème est que le code prend trop de temps à exécuter. J'aimerais donc l'optimiser car je voudrais faire la validation sur 4000 lignes.
Voir fichier joint
Merci de votre aide
Code:
rivate Sub CommandButton1_Click()
Dim myrange As Range
Dim cell As Range
Dim count As Integer
Dim a As Integer
For a = 12 To 50
Set myrange = ActiveSheet.Range("J" & a & ":AC" & a)
count = 20 * Range("G" & a).Value
For Each cell In myrange
If count > 0 Then
'cell.Value = "x"
With cell.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 90
.Gradient.ColorStops.Clear
End With
With cell.Interior.Gradient.ColorStops.Add(0)
.Color = 15773696
.TintAndShade = 0
End With
With cell.Interior.Gradient.ColorStops.Add(0.5)
.Color = 65535
.TintAndShade = 0
End With
With cell.Interior.Gradient.ColorStops.Add(1)
.Color = 15773696
.TintAndShade = 0
End With
count = count - 1
Else
'cell.Value = ""
With cell.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 90
.Gradient.ColorStops.Clear
End With
With cell.Interior.Gradient.ColorStops.Add(0)
.Color = 15773696
.TintAndShade = 0
End With
With cell.Interior.Gradient.ColorStops.Add(0.5)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With cell.Interior.Gradient.ColorStops.Add(1)
.Color = 15773696
.TintAndShade = 0
End With
End If
Next cell
Next
End Sub