XL 2016 Gestion des boucles, accélération de macro

[julien6337]

Bonjour,
la macro que j'avais dans un fichier devient trop lente du fait de la taille du fichier. elle fonctionnait parfaitement.
Je voudrais ajouter une condition pour qu'elle ne s'applique que sur les lignes ou la chaine de caractère LTV n'est pas trouvée en colonne 13 du tableau, j'ai donc ajouté une ligne de code 'en gras ci dessous) pour intégrer cette condition mais ça ne fonctionne pas. Avez vous une idée pour que ça fonctionne ou pour accélérer la macro

D'avance merci pour vos retours

Sub PrepacalcPOWERBI()

Worksheets("Transfert").Range("EH2:IP3000").ClearContents

NbLigne = Application.Subtotal(3, Range("A:A")) 'compte le nombre de ligne titre inclus

Dim i As Integer, j As Integer

For i = 2 To NbLigne ' NbLigne boucle de la ligne 2 au nombre de ligne
If Cells(i, 13).Value = "*LTV*" Then Next i
Else

For j = 25 To 136

If Cells(i, j).Interior.ColorIndex = 7 Then 'colorindex 7 = Rose
Cells(i, j + 113) = "Deformee Nuit"

ElseIf Cells(i, j).Interior.ColorIndex = 6 Then Cells(i, j + 113) = "Deformee jour"

ElseIf Cells(i, j).Interior.ColorIndex = 33 Then Cells(i, j + 113) = "Generique jour"

ElseIf Cells(i, j).Interior.ColorIndex = 14 Then Cells(i, j + 113) = "Fermeture"

End If

Next j
Next i


End Sub

 

[sylvanu]

Bonjour Julien,
Avec le code ci dessous cela devrait améliorer un peu les choses :

Sub PrepacalcPOWERBI()
Worksheets("Transfert").Range("EH2:IP3000").ClearContents
NbLigne = Application.Subtotal(3, Range("A:A")) 'compte le nombre de ligne titre inclus
Dim i As Integer, j As Integer, Couleur
For i = 2 To NbLigne ' NbLigne boucle de la ligne 2 au nombre de ligne
    If Cells(i, 13).Value <> "*LTV*" Then
        For j = 25 To 136
            Couleur = Cells(i, j).Interior.ColorIndex
            Select Case Couleur
                Case 7: Cells(i, j + 113) = "Deformee Nuit"
                Case 6: Cells(i, j + 113) = "Deformee jour"
                Case 33: Cells(i, j + 113) = "Generique jour"
                Case 14: Cells(i, j + 113) = "Fermeture"
            End Select
        Next j
    End If
Next i
End Sub

Le Couleur = Cells(i, j).Interior.ColorIndex permet de réduire le nombre de lecture, les "Case" permettent d'accélérer encore un peu.

( pour le code utiliser la balise </> c'est plus lisible )

 

[sylvanu]

J'ai oublié, on peut accélérer en figeant l'écran et en interdisant les calculs :

Sub PrepacalcPOWERBI()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Worksheets("Transfert").Range("EH2:IP3000").ClearContents
NbLigne = Application.Subtotal(3, Range("A:A")) 'compte le nombre de ligne titre inclus
Dim i As Integer, j As Integer, Couleur
For i = 2 To NbLigne ' NbLigne boucle de la ligne 2 au nombre de ligne
    If Cells(i, 13).Value <> "*LTV*" Then
        For j = 25 To 136
            Couleur = Cells(i, j).Interior.ColorIndex
            Select Case Couleur
                Case 7: Cells(i, j + 113) = "Deformee Nuit"
                Case 6: Cells(i, j + 113) = "Deformee jour"
                Case 33: Cells(i, j + 113) = "Generique jour"
                Case 14: Cells(i, j + 113) = "Fermeture"
            End Select
        Next j
    End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[julien6337]

merci Beaucoup, ça va beaucoup plus vite et excel ne plante plus.