Optimiser une macro pour supprimer des cellules en couleur et fusionnées

Bonjour à tous,

Voila j'ai créé une macro pour supprimer des cellules en couleur et fusionnées, sous certaines conditions (certaines ne sont pas effacées).

Elle fonctionne, elle est plutôt rapide lorsqu'il y a peu de cellules sélectionnées.

Par contre, dans le tableau définitif, il y a 7000 cellules sélectionnées à la fois pour faire le ménage, donc ça rame grave.

Voici le code :

Sub Effacer()

Dim cellule As Range

Application.ScreenUpdating = False
'Application.EnableEvents = False

For Each cellule In Selection

    If cellule.Interior.Color = RGB(0, 0, 0) Then
        If cellule.Interior.Pattern = 1 Then
            GoTo FinSi
        Else
            cellule.UnMerge
            cellule.ClearContents
            With cellule.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If

    ElseIf cellule.Interior.Color = RGB(166, 166, 166) Then
        GoTo FinSi

    ElseIf cellule.Interior.Color = RGB(191, 191, 191) Then
        GoTo FinSi

    Else
        cellule.UnMerge
        cellule.ClearContents
        With cellule.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        'cellule.Interior.Color = RGB(255, 255, 255)

FinSi:

    End If

Next

'Application.EnableEvents = True
Application.ScreenUpdating = True
'Worksheets("Planning production").Calculate

End Sub

Si quelqu'un peut m'aider à optimiser ce code, ça serait génial.

Je joins un fichier modèle pour mieux comprendre

Bonjour

A quoi correspond Selection dans votre code ?

Bonjour Dan,

Selection correspond aux cellules sélectionnées que je veux effacer

Selection correspond aux cellules sélectionnées que je veux effacer

Oui cela je le savais mais je voulais avoir un exemple de sélection dans votre feuille pour tester

Je ne vois pas pourquoi vous avez rajouté cette condition -->

 If cellule.Interior.Pattern = 1 Then

Cela veut simplement dire que vous avez une couleur dans la cellule et le RGB(0,0,0) c'est pour la cellule coloriée en noir

Bonjour Dan,

Je complète un peu ma demande si ça peut aider.

If cellule.Interior.Color = RGB(0, 0, 0) Then
        If cellule.Interior.Pattern = 1 Then

Dans mon cas, c'est la seule solution que j'ai trouvé pour faire ce que je veux faire.

- le RGB(0,0,0) conditionne si la cellule est noire, mais aussi quand la couleur de la cellule est en dégradé, puisque dans ce cas, le .interior.color remonté = 0 (noir)

- le . pattern=1 me permet de ne pas traiter les cellules en noir : en gros le Else qui suit traite les cellules en dégradé.

Je sais bien que ce n'est pas très propre mais c'est la seule solution que j'ai trouvé pour traîter l'ensemble des cas.

Dans le fichier :

- à gauche : ce que je veux en partant des cellules (B4:H16) pour arriver à (B21:H33)

- à droite : c'est pour la vitesse à plus grande échelle. La macro fonctionne, mais ça ralenti déjà.

Sur le fichier final ou je sélectionne un peu moins de 7000 cellules, c'est une catastrophe : après 1 heure, Excel mouline encore.

bonjour, il faut joindre les cellules et les traiter en une fois

Sub Effacer()

     Dim cellule As Range, UN
     t = Timer
     Set UN = Cells(1, Columns.Count)
     For Each cellule In Range("A1:AD300").Cells     'environ 9.000 cellules
          i = i + 1
          Select Case cellule.Interior.Color
               Case RGB(0, 0, 0): If cellule.Interior.Pattern <> 1 Then j = j + 1: Set UN = Union(UN, cellule)
               Case RGB(166, 166, 166), RGB(191, 191, 191)
               Case Else: j = j + 1: Set UN = Union(UN, cellule)
          End Select
     Next

     With UN
          .UnMerge
          .ClearContents
          With .Interior
               .Pattern = xlNone
               .TintAndShade = 0
               .PatternTintAndShade = 0
          End With
     End With

     MsgBox "en total " & Format(i, "#,###") & " cellules" & vbLf & "donc " & Format(j, "#,###") & " cellules traitées" & vbLf & "temps : " & Format(Timer - t, "0.0\s")

End Sub

Sur le fichier final ou je sélectionne un peu moins de 7000 cellules, c'est une catastrophe : après 1 heure, Excel mouline encore.

Merci de votre retour, j'avais regardé pour finaliser une proposition mais comme BsALv s'en est occupé voyez ce qu'il propose.

Crdlt

Merci beaucoup BsALV,

Le code fonctionne parfaitement avec un gain de temps énorme.

Merci aussi Dan.

re,

il a fait ce job en combien de temps ? Moins d'une seconde ?

Sur le tableau final avec 7000 cellules sélectionnées, avec le recalcul qui en découle : 75 secondes au lieu de 1h (et je l'ai arrêté)