SELECTION DE CELLULES

pierrejean

XLDnaute Barbatruc

• 25 Août 2016

• #2

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

 

Vote positif 0 Vote négatif

Paf

XLDnaute Barbatruc

• 25 Août 2016

• #3

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+

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 25 Août 2016

• #4

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

 

Pièces jointes

• ABDELHAK- CN_TEST- v1c.xls

  64.5 KB · Affichages: 42

Dernière édition: 25 Août 2016

Vote positif 0 Vote négatif

A

ABDELHAK

XLDnaute Occasionnel

• 26 Août 2016

• #5

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

Cliquez pour agrandir...

 

Vote positif 0 Vote négatif

A

ABDELHAK

XLDnaute Occasionnel

• 26 Août 2016

• #6

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

 

Pièces jointes

• CN_TEST.xls

  273 KB · Affichages: 39

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 26 Août 2016

• #7

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

 

Pièces jointes

• ABDELHAK- CN_TEST- v2.xls

  67 KB · Affichages: 47
• ABDELHAK- CN_TEST- v2a.xls

  71 KB · Affichages: 38
• ABDELHAK- CN_TEST- Compare- v2 v2a.xls

  69 KB · Affichages: 37

Dernière édition: 26 Août 2016

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 26 Août 2016

• #8

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

 

Vote positif 0 Vote négatif

A

ABDELHAK

XLDnaute Occasionnel

• 26 Août 2016

• #9

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.

Cliquez pour agrandir...

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

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 26 Août 2016

• #10

Re,

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

 

Pièces jointes

• ABDELHAK- CN_TEST- v3.xls

  562 KB · Affichages: 51
• ABDELHAK- CN_TEST- Compare- v2 v2a v3.xls

  74.5 KB · Affichages: 43

Vote positif 0 Vote négatif

A

ABDELHAK

XLDnaute Occasionnel

• 26 Août 2016

• #11

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

 

Vote positif 0 Vote négatif

A

ABDELHAK

XLDnaute Occasionnel

• 27 Août 2016

• #12

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

Cliquez pour agrandir...

 

Vote positif 0 Vote négatif

A

ABDELHAK

XLDnaute Occasionnel

• 27 Août 2016

• #13

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

 

Pièces jointes

• CN_TEST- Compare- v2 v2a v3 - Copie.xls

  1.1 MB · Affichages: 40

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 27 Août 2016

• #14

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

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 27 Août 2016

• #15

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. (...)

Cliquez pour agrandir...

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...

 

Pièces jointes

• ABDELHAK- CN_TEST- v4.zip

  278 KB · Affichages: 44

Dernière édition: 27 Août 2016

Vote positif 0 Vote négatif