macro pas très très rapide :s

[fifi]

bonsoir le forum,

dans un classeur assez lourd... (ce commence bien)

j'ai une macro qui risque de tourner assez souvent selon les demandes de l'utilisateur.
Le problème est que cette macro est assez lente sur mon pc ..alors j'imagine pas ce que ca va donner sur un pc limite coté mémoire.


il y at-il une possibilité d'améliorer ce code svp ?

sa fonction: faire la liste des différentes valeurs dans une plage en stockant les valeurs dans une colonne précolorée. Cette colonne (X) défini donc des groupes avec une police et une couleur donnés.

puis dans une autre plage de données, la macro colorie les cellules en fonction de leur valeurs à l'identique de celle correspondante de la colonne (X).
La macro permet donc de colorier des cellules en fonction de groupe définis.

Application.Calculation = xlManual
Application.EnableEvents = False

Dim c as range
Dim I as integer
Dim Old as variant
            I = 0
                For Each C In Sheets("Exploitation").Range("result")

                        I = I + 1
                        If Sheets("Plaque finale").Range("extraction_plate_cplt").Item(I).Offset(n - 4, 0) = "" Then
                            C.Interior.ColorIndex = xlNone
                            C.Font.ColorIndex = xlNone
                            Cells(C.Row, C.Column).Offset(1, 0).Interior.ColorIndex = xlNone
                            Cells(C.Row, C.Column).Offset(1, 0).Font.ColorIndex = xlNone
                            GoTo cellule_suivante
                            
                        End If
                        C = Sheets("Plaque finale").Range("extraction_plate_cplt").Item(I).Offset(n - 4, 0).Value
                           
                            C.Offset(1, 0) = Sheets("Plaque finale").Range("extraction_plate_cplt").Item(I).Value
                            If C = oldC And I > 1 Then GoTo no_search_color
                            oldC = C
search_couleur:
                                With Sheets("listes").Range("Listes_info_plaque_en_cours")
                                    Set d = .Find(C, LookIn:=xlFormulas, lookat:=xlWhole)
                                    If Not d Is Nothing Then
                                        Couleur = d.Interior.ColorIndex
                                        couleur_font = d.Font.ColorIndex
                                    Else
                                        m = Sheets("listes").Cells(65535, Sheets("listes").Range("Listes_info_plaque_en_cours").Column).End(xlUp).Row + 1
                                        Sheets("listes").Cells(m, Sheets("listes").Range("Listes_info_plaque_en_cours").Column) = C
                                        GoTo search_couleur
                                    End If
                                End With
no_search_color:
                            C.Interior.ColorIndex = Couleur
                            C.Font.ColorIndex = couleur_font
                            Cells(C.Row, C.Column).Offset(1, 0).Interior.ColorIndex = Couleur
                            Cells(C.Row, C.Column).Offset(1, 0).Font.ColorIndex = couleur_font
cellule_suivante:
                Next C

si quelqu'un peut m'aider sur la méthode pour accelerer cette macro svp 😀

 

[JCGL]

Re : macro pas très très rapide :s

Bonjour à tous,

Avec le code complet et le fichier, il aurait été plus aisé de tenter de t'aider...

Peux-tu essayer avec :

'........
With Application
.Calculation = xlManual
.EnableEvents = False
.ScreenUpdating = 0
End With

Dim c As Range
Dim I As Integer
Dim Old As Variant
I = 0
For Each c In Sheets("Exploitation").Range("result")

    I = I + 1
    If Sheets("Plaque finale").Range("extraction_plate_cplt").Item(I).Offset(n - 4, 0) = "" Then
        c.Interior.ColorIndex = xlNone
        c.Font.ColorIndex = xlNone
        Cells(c.Row, c.Column).Offset(1, 0).Interior.ColorIndex = xlNone
        Cells(c.Row, c.Column).Offset(1, 0).Font.ColorIndex = xlNone
        GoTo cellule_suivante

    End If
    c = Sheets("Plaque finale").Range("extraction_plate_cplt").Item(I).Offset(n - 4, 0).Value

    c.Offset(1, 0) = Sheets("Plaque finale").Range("extraction_plate_cplt").Item(I).Value
    If c = oldC And I > 1 Then GoTo no_search_color
    oldC = c
search_couleur:
    With Sheets("listes").Range("Listes_info_plaque_en_cours")
        Set d = .Find(c, LookIn:=xlFormulas, lookat:=xlWhole)
        If Not d Is Nothing Then
            Couleur = d.Interior.ColorIndex
            couleur_font = d.Font.ColorIndex
        Else
            m = Sheets("listes").Cells(65535, Sheets("listes").Range("Listes_info_plaque_en_cours").Column).End(xlUp).Row + 1
            Sheets("listes").Cells(m, Sheets("listes").Range("Listes_info_plaque_en_cours").Column) = c
            GoTo search_couleur
        End If
    End With
no_search_color:
    c.Interior.ColorIndex = Couleur
    c.Font.ColorIndex = couleur_font
    Cells(c.Row, c.Column).Offset(1, 0).Interior.ColorIndex = Couleur
    Cells(c.Row, c.Column).Offset(1, 0).Font.ColorIndex = couleur_font
cellule_suivante:
Next c

With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = 1
End With

'.....

A+ à tous

 

[fifi]

Re : macro pas très très rapide :s

désolé le classeur est trop trop lourd avec beaucoup de plage nommée ;c'est chaud pour en faire un petit fichier .

le .ScreenUpdating = 0 en plus n'accelere rien car en début de macro(évenementielle) j'avais déjà retiré l'affichage.


bon allé je confectionne un petit exemple.
merci JCGL