Comparaison couleur puis suppression

[bambi]

Bonsoir à tous

Dans le fichier suivant (pour l'exemple), dans la colonne A, lorsque j'ai deux cellules successives colorées, (mais ça peut être trois cellules successives ou plus), je voudrais ne garder que la dernière ligne correspondante.

J'ai mis un fichier avec deux tableaux en exemple pour un résultat souhaité identique
J'espère que mon fichier joint sera plus explicite que moi

Merci d'avance

 

[bambi]

Re : Comparaison couleur puis suppression

Bonsoir Stapple

Oui effectivement, j'ai utilisé le même fichier pour donner un exemple (car je sais que c'est plus facile à comprendre si on met une pièce jointe en exemple) mais pour tout te dire, il ne me sert que de modèle pour avoir une base de Macro a retravailler.
Mon fichier définitif est très différent et beaucoup plus conséquent.

Je n'aurais peut-être pas dû en mettre ou plutôt en mettre un totalement différent, ça n'aurait pas prêté à confusion.

Et je trouvais pas mal d'avoir deux macro différentes car cela me permet de les comprendre pour les adapter plus facilement à mon travail final.

Et surtout, je compte les utiliser séparément pour une autre application.

C'est pour cela que je n'ai pas mis mon message à la suite car il ne s'agit pas de compléter ma 1ere demande à laquelle tu fais référence

Vraiment désolée de la confusion.

 

[CISCO]

Re : Comparaison couleur puis suppression

Bonsoir

Est-ce indispensable de faire cela avec une macro ? Une solution avec des formules ne te conviendrait elle pas ?

@ plus

 

[bambi]

Re : Comparaison couleur puis suppression

Bonsoir cisco
Le problème de la formule suppose que le tableau soit défini avant non ?

Hors là, il va s'agir pour moi d'applications multiples donc d'une macro que j'attribuerai sans doute à un bouton et que je compte appliquer après un ou plusieurs traitements précédents des données
Donc j'avoue que je ne suis pas bien sûre que cela puisse convenir, il faudrait voir.

 

[bqtr]

Re : Comparaison couleur puis suppression

Bonsoir à tous,

Si j'ai bien compris, voici un exemple :

Option Explicit

Sub SupLign()

Dim k As Long, y As Long, Tablo()

Application.ScreenUpdating = False

For k = 9 To Range("A65536").End(xlUp).Row
  If k = Range("A65536").End(xlUp).Row Then Exit For
  If Cells(k, 1).Interior.ColorIndex <> xlNone And Cells(k + 1, 1).Interior.ColorIndex <> xlNone Then
     ReDim Preserve Tablo(1, y)
     Tablo(1, y) = k
     y = y + 1
  End If
Next

On Error Resume Next '(si le tableau Tablo est vide)
For k = UBound(Tablo, 2) To LBound(Tablo, 2) Step -1
  Rows(Tablo(1, k)).Delete
Next
On Error GoTo 0

Application.ScreenUpdating = True
End Sub

A+

 

[bambi]

Re : Comparaison couleur puis suppression

Bonjour bqtr
Merci pour ton travail. C'est effectivement ce que je cherche à faire.

Par contre, afin que je comprenne mieux comment m'en servir, la modifier et l'insérer dans d'autres macros ou encore l'adapter, peux tu me mettre des commentaires dans ce que tu as fait si tu as le temps ?

Merci d'avance

 

[bqtr]

Re : Comparaison couleur puis suppression

Bonsoir à tous,

Voici le code commenté :

Sub SupLign()

Dim k As Long, y As Long, Tablo()

'Permet de geler le rafraichissement de l'affichage et accélère un peu la vitesse d'exécution de la macro
Application.ScreenUpdating = False
'On boucle de la ligne 9 à la dernièere ligne non vide de la colonne A
For k = 9 To Range("A65536").End(xlUp).Row
'Si k = le n° de la dernière ligne non vide de la colonne A on quitte la boucle
  If k = Range("A65536").End(xlUp).Row Then Exit For
  'On teste si une couleur a été mise dans la cellule ligne k, ainsi que dans la cellule suivante ligne k + 1
  If Cells(k, 1).Interior.ColorIndex <> xlNone And Cells(k + 1, 1).Interior.ColorIndex <> xlNone Then
  'Si le teste est positif on met le n° (k) de la ligne qui sera supprimée dans un tableau que l'on redimensionne au fur et à mesure des tests
  'Le tableau aura 1 ligne et y colonne en fonction des tests
     ReDim Preserve Tablo(1, y)
     'On place le n° de ligne qui sera supprimée dans le tableau
     Tablo(1, y) = k
     'On incrémente le n° de la prochaine colonne du tableau
     y = y + 1
  End If
Next
'Evite un plantage de la macro si le tableau Tablo est vide, annulation de la gestion des erreurs par VBA
On Error Resume Next
'On boucle du nombre maxi de colonne du tableau à la première à rebours (par pas de -1)
'Cela évite les erreurs lors de la suppression des linges
For k = UBound(Tablo, 2) To LBound(Tablo, 2) Step -1
  'Suppression de la ligne
  Rows(Tablo(1, k)).Delete
Next
'on rétabli la gestion des erreurs par VBA
On Error GoTo 0
'Désactive le gel du rafraichissement de l'écran
Application.ScreenUpdating = True

End Sub

A+

 

[bambi]

Re : Comparaison couleur puis suppression

Merci beaucoup bqtr
Très pédagogique !!! Génial !!