SELECTION DE CELLULES

ABDELHAK · 25 Août 2016

Bonjour à tous,

J’aimerais encore faire appel à votre savoir-faire.

En effet j’aimerais réaliser une macro qui exécute les tâches suivantes.

J’ai un fichier dont la feuille s’appelle « CHIFFRE_10 ».

La macro doit commencer à lire la ligne n°2, reconnaître les cellules à fond vert et effacer les cellules qui ne le sont pas. Les cellules contenant les dates (COLONNE A) ne doivent en aucun cas être effacées.
La macro doit lire la ligne n°3, reconnaître les cellules à fond vert et effacer les cellules qui ne le sont pas. Les cellules contenant les dates (COLONNE A) ne doivent en aucun cas être effacées.
La macro doit lire la ligne n°4, reconnaître les cellules à fond vert et effacer les cellules qui ne le sont pas. Les cellules contenant les dates (COLONNE A) ne doivent en aucun cas être effacées.
Et ainsi de suite jusqu’à la dernière ligne.

En espérant avoir été claire et concis.

Je vous remercie déjà pour votre aide.

Bien à vous.

ABDELHAK

pierrejean · 25 Août 2016

Bonjour ABDELHAK

A tester:

Code:

For n = 2 To Range("A" & Rows.Count).End(xlUp).Row
   For m = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
        If Not Cells(n, m).Interior.Color = 65280 Then
          Cells(n, m) = ""
        End If
   Next
Next

Paf · 25 Août 2016

Bonjour ABDELHAK, pierrejean ,

c'est presque la même chose que pierrejean, mais comme c'était fait ...

Code:

 For Each CEL In Range("B2:U" & Range("B" & Rows.Count).End(xlUp).Row)
  If CEL.Interior.ColorIndex = 4 Then
      CEL.ClearContents ' si on veut n'effacer que les données
      'CEL.Clear si on veut effacer également la couleur de fond
  End If
Next

A+

mapomme · 25 Août 2016

Bonsoir ABDELHAK, pierrejean , Paf ,

Pour le fun, un essai pour traiter toutes les cellules vertes, même si les verts sont différents (j'ai pompé vos codes en grande partie)

edit : v1c - hé bien, j'avais fait le contraire de ce qu'il fallait faire

ABDELHAK · 26 Août 2016

pierrejean à dit:

Bonjour ABDELHAK

A tester:

Code:

For n = 2 To Range("A" & Rows.Count).End(xlUp).Row
   For m = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
        If Not Cells(n, m).Interior.Color = 65280 Then
          Cells(n, m) = ""
        End If
   Next
Next

ABDELHAK · 26 Août 2016

Bonjour Pierrejean,

Merci beaucoup pour m’avoir réalisé cette macro.

Je l’ai testé et c’est tout simplement magique car c’est ce que je voulais.

Néanmoins le résultat final ressemble à un « gruyère ».

Y aurait-il moyen de réaliser une seconde macro pour ranger les cellules restantes ligne par ligne.

Je joins le fichier avec la macro que j’ai testé. En l’ouvrant ce sera plus claire, je l’espère.

Quoiqu’il en soit, Je vous remercie déjà pour votre aide.

Bien à vous.

ABDELHAK

mapomme · 26 Août 2016

Bonjour ABDELHAK,

Si j'ai bien compris, avec le décalage...

edit : v2a une version plus rapide s'il y a de nombreuses lignes.
edit : un fichier comparatif des durées de v2 et v2a

pierrejean · 26 Août 2016

Re
Salut tapomme (je regarde ta production)
A tester

Code:

Application.ScreenUpdating = False
   For m = Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
       For n = 2 To Range("A" & Rows.Count).End(xlUp).Row
         If Not Cells(n, m).Interior.Color = 65280 Then
          Cells(n, m).Delete Shift:=xlToLeft
        End If
   Next
Next
Application.ScreenUpdating = True

ABDELHAK · 26 Août 2016

mapomme à dit:
Bonjour ABDELHAK,

Si j'ai bien compris, avec le décalage...

edit : v2a une version plus rapide s'il y a de nombreuses lignes.

Bonjour Pierrejean,

En un seul mot WAAAAAAOUHHH !!!!!!

Merci beaucoup pour votre aide et votre perspicacité.

Je ne le dirai jamais assez, vous êtes tous des gens formidables. Si je vous dis cela, c’est que j’ai été déjà aider à de nombreuses reprises, vous avez dû certainement le constater.

En tous cas, cette macro répond à toutes mes attentes.

1000 merci.

Bien à vous

ABDELHAK

mapomme · 26 Août 2016

Re,

Une version der des der. En poussant la logique du tableau jusqu'au bout. Une v3 plus rapide.

ABDELHAK · 26 Août 2016

Bonjour mapomme,

1000 merci pour les macros que vous m’avez envoyé.

Je n’attendais tout simplement pas autant. Mais là, vous avez casser la baraque.

Bravo à ce que vous faîtes.

A bientôt

Bien à vous

ABDELHAK

ABDELHAK · 27 Août 2016

ABDELHAK à dit:
Bonjour mapomme,

1000 merci pour les macros que vous m’avez envoyé.

Je n’attendais tout simplement pas autant. Mais là, vous avez casser la baraque.

Bravo à ce que vous faîtes.

A bientôt

Bien à vous

ABDELHAK

ABDELHAK · 27 Août 2016

Bonjour mapomme,

Et encore 1000 merci pour les macros que vous m’avez envoyé.

Je viens de tester les dernières macro et de réaliser par la même occasion que les 3 versions avaient comme différences la vitesse d’exécution de la macro.

C’est tout simplement incroyable, en effet la macro » VIDER LES NON VERTS ET DECALER V3 « effectue la tâche en seulement 13 petites secondes. Je l’ai testé à +ieurs reprises pour y croire.

Je sais d’avance que j’abuse de votre gentillesse, mais si vous le voulez, pourriez-vous me réaliser la même macro en y intégrant cette fois-ci une condition ?

La macro devra effectuer les mêmes procédures, mais en plus j’aimerais qu’elle sélectionne les lignes ayant 10 cellules vertes ou plus et effacer le reste.

De toutes manières, je vous suis reconnaissant pour ce que vous avez réalisé pour moi.

A bientôt

Bien à vous

ABDELHAK

pierrejean · 27 Août 2016

Re

A utiliser apres la v3

Code:

Sub efface()
Dim n&
Application.ScreenUpdating = False
For n = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
 If Cells(n, Columns.Count).End(xlToLeft).Column < 11 Then
   Rows(n).Delete
 End If
Next
Application.ScreenUpdating = True
End Sub

Et pour illustrer l'incapacité de l’œil à apprécier les nuances de couleur

Code:

Sub essai()
Range("W1").Interior.Color = RGB(254, 255, 254)
MsgBox ("W1 Plutot vert ?  " & PlutotVert(Range("W1")))
Range("W1").Interior.Color = RGB(0, 1, 0)
MsgBox ("W1 Plutot vert ?  " & PlutotVert(Range("W1")))
Range("W1").Interior.Color = RGB(124, 125, 124)
MsgBox ("W1 Plutot vert ?  " & PlutotVert(Range("W1")))
End Sub

mapomme · 27 Août 2016

Bonjour ABDELHAK ,

ABDELHAK à dit:
(...) pourriez-vous me réaliser la même macro en y intégrant cette fois-ci une condition ?

La macro devra effectuer les mêmes procédures, mais en plus j’aimerais qu’elle sélectionne les lignes ayant 10 cellules vertes ou plus et effacer le reste. (...)

Voici la v4.

Une constante 'AuMoins' indique le nombre minimum de cases vertes par ligne pour conserver la ligne. La valeur de la constante est modifiable dans le code de la v4.

La fonction PlutotVert a été remplacée par NbrPlutotVert(xrg As Range) qui renvoie le nombre de cellules plutôt vertes dans le range xrg.

ABDELHAK, chez moi la v4 prend environ 8 secondes et chez toi ? Quel processeur as tu ? (je songe sérieusement remplacer mon ordi de 2007 que j'avais construit en 2007 !)

Edit: Bonjour pierrejean , je regarde ton essai...

SELECTION DE CELLULES

ABDELHAK

XLDnaute Occasionnel

Pièces jointes

pierrejean

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

ABDELHAK

XLDnaute Occasionnel

ABDELHAK

XLDnaute Occasionnel

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

pierrejean

XLDnaute Barbatruc

ABDELHAK

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Pièces jointes

ABDELHAK

XLDnaute Occasionnel

ABDELHAK

XLDnaute Occasionnel

ABDELHAK

XLDnaute Occasionnel

Pièces jointes

pierrejean

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Discussions similaires