Accélérer Macro

[pierrof]

Re-bonjour
Je trouve ma macro un peu lente, pouvez-vous me donnez des conseils pour l'accélerer ci-joint mon code:

Application.ScreenUpdating = False
Dim i As Long, j As Long
'afficher lignes
Macro4
'supprimer couleur
Macro5

'colorer les cellules
Columns("K:K").Select
With Selection.Interior
.Pattern = xlNone
End With

For i = 2 To 50000
If Cells(i, 6).Value = "KM RETOUR" Then
If Not Cells(i, 11).Value = "TVOI" Then
Cells(i, 11).Select
With Selection.Interior
.ColorIndex = 6
End With
End If
End If
Next i

'msg box avec le nombre d'erreurs
coul = 6
Total = 0
Range("K2:K50000").Select
For Each Cellule In Selection:
If Cellule.Interior.ColorIndex = coul Then Total = Total + 1
Next
Range("A1").Select
MsgBox "Il y a " & Total & " erreurs sur le service KMRT"


'Masquer lignes
For j = [K65536].End(xlUp).Row To 2 Step -1
If Cells(j, "K").Interior.ColorIndex = xlNone Then
Rows(j).Hidden = True
End If
Next

Application.ScreenUpdating = True

 

[pierrof]

Re : Accélérer Macro

Bonjour

Concernant les boucles sur 50000 lignes je pense les diminuer par la suite jusqu'a 10000
je joint un fichier pour plus de clarté
Merci

 

[pierrof]

Re : Accélérer Macro

Merci Jean-Marcel
Je gagne un peu de temps, je pense que je vais réduire la taille de des boucles
A+

 

[Efgé]

Re : Accélérer Macro

RE, RE pierrof,
Bonjour Jean-Marcel, bonjour Staple1600,
Comme je suis d'un naturel tétu, mais après celui ci j'arrete 😎, je pense que l'on peut faire les deux opérations (colorisation et masquage) en une seule boucle.
Sans l'activation de la boite de dialogue "nombre d'erreur" on arrive à 0.1 seconde...

Private Sub CommandButton1_Click()
'TempsDepart = Timer
Application.ScreenUpdating = False
Dim i As Long, j As Long
Dim Cellule As Range
'afficher lignes
Rows("2:50000").EntireRow.Hidden = False
'supprimer couleur
Columns("K:K").Interior.Pattern = xlNone
'colorer les cellules et mas quer les lignes
coul = 6
Total = 0
For j = [F65536].End(xlUp).Row To 2 Step -1
If Cells(j, 6).Value = "K" Then
If Not Cells(j, 11).Value = "T" Then
Cells(j, 11).Select
With Selection.Interior
.ColorIndex = 6
Total = Total + 1
End With
Else
Rows(j).Hidden = True
End If
End If
Next
Range("A1").Select
'msg box avec le nombre d'erreurs
MsgBox "Il y a " & Total & " erreurs sur le service KMRT"

TempsFin = Timer
' Affiche le temps total en secondes
'MsgBox Format(TempsFin - TempsDepart, "0.0") & " Secondes"
'Application.ScreenUpdating = True
End Sub

Cordialement et bon courage 😉

 

[Efgé]

Re : Accélérer Macro

Re


Pourquoi conserver le Select 😕

If Not Cells(j, 11).Value = "T" Then
Cells(j, 11).Interior.ColorIndex = 6
Total = Total + 1

Par mauvaise habitude, uniquement 😱 😉
Cordialement