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

mapomme · 27 Août 2016

Bonjour pierrejean ,

pierrejean à dit:
(...) Et pour illustrer l'incapacité de l’œil à apprécier les nuances de couleur

Code:

sub essai (...) End Sub

Tu chipotes un tout petit peu, non ? En fait, tu as entièrement raison. J'avoue que j'ai quelque difficulté à reconnaître tes couleurs comme du vert. On peut noter que les couleurs choisies sont des couleurs voisines d'un gris (R=G=B)

Je suis en train de travailler sur les représentations des couleurs RGB, HSL et HSV. Ce n'est pas aussi simple que ça en a l'air au départ. Je pense à faire une fonction PlutotDeTelleCouleur ; les systèmes HSL ou HSV semblent plus adaptés (mais il y en a d'autres). Pour l'instant, je découvre et bricole le HSL.

Bonne journée...

pierrejean · 27 Août 2016

En fait, je chipote beaucoup !!!!!
Je ne savais même pas que le le HSL existe Quésaco ???

mapomme · 27 Août 2016

Re pierrejean,

pierrejean à dit:
(...) HSL Quésaco???

HSL ou bien TSL en français pour Teinte, Saturation, Luminosité. Voir un article de Wikipedia. Voir un convertisseur RGB <-> HSL.

STephane · 27 Août 2016

Bonjour,

Intéressé par ce fil, j'ai trouvé un fichier dont les fonctions VBA peuvent vous intéresser.
https://app.box.com/s/qj4n5yesh0qoutxtn3sa

Trouvé sur MrExcel.com

Bye
STéphane

job75 · 28 Août 2016

Bonjour ABDELHAK, Pierre, mapomme, STephane,

Dans le fichier joint j'utilise le dernier tableau de mapomme (6500 lignes).

Sur Win 10 - Excel 2013 cette macro s'exécute en 2,7 seconde :

Code:

Sub FiltreCouleur()
'nom défini en A1 => Couleur =LIRE.CELLULE(38;Feuil1!A1)
'cellules W2 et W5 nommées Code et Minimum
Dim dur#, ncol%, n&, a$
dur = Timer
Application.ScreenUpdating = False
[A1].CurrentRegion.EntireColumn.Copy [Y1] 'Y1 à adapter
With [Y1].CurrentRegion.Offset(1, 1)
  ncol = .Columns.Count
  '---effacement des cellules non colorées---
  .Resize(, ncol - 1) = "=REPT(B2,Couleur=Code)"
  '---concaténation en colonne Z et conversion de données---
  For n = 1 To ncol - 1
    a = a & "&"" ""&RC[" & n - ncol & "]"
  Next
  ThisWorkbook.Names.Add "concat", "=" & Mid(a, 6) 'nom défini
  .Columns(ncol) = "=TRIM(concat)"
  .Columns(ncol) = .Columns(ncol).Value
  .Columns(1) = .Columns(ncol).Value
  .Columns(2).Resize(, ncol - 2) = "" 'RAZ
  .Columns(2).Resize(, ncol - 2).Interior.ColorIndex = xlNone 'RAZ
  .Columns(1).TextToColumns .Cells(1), xlDelimited, Space:=True
  '---suppression des lignes < Minimum---
  .Columns(ncol) = "=LN(COUNTA(RC[" & 1 - ncol & "]:RC[-1])>=Minimum)"
  .Columns(ncol) = .Columns(ncol).Value
  .Columns(0).Resize(, ncol + 1).Sort .Columns(ncol), xlAscending, Header:=xlNo 'tri pour accélérer
  n = Application.Count(.Columns(ncol))
  .Columns(ncol) = ""
  .Cells(n + 1, 0).Resize(Rows.Count - n - .Row + 1, ncol).Delete xlUp
  '---recoloration---
  On Error Resume Next
  .SpecialCells(xlCellTypeConstants).Interior.Color = [Code].Interior.Color
End With
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - dur, "0.00 \s") & vbLf & vbLf & _
  Application.Max([A1].CurrentRegion.Rows.Count - 1 - n, 0) & " ligne(s) supprimée(s)"
End Sub

On notera qu'il n'y a pas de boucle pour traiter le tableau.

Edit : pour la RAZ j'avais effacé, à tord, tous les formats.

A+

mapomme · 28 Août 2016

Bonjour job75,

Alors là, chapeau bas ! Il fallait le sortir ce code. La vitesse d'exécution est deux à trois fois plus élevée que ma version v4 qui est dans les choux . J'apprécie à sa juste valeur ce code (fonction Couleur, la concaténation puis le Convertir, et aussi la fonction Couleur via Excel iv (je n'y pense jamais). Bravo! Je joins un fichier avec ta macro et la mienne.

Edit: j'ai rendu à job75 ce qu'il lui appartient et le prie de bien vouloir m'excuser

job75 · 28 Août 2016

Re,

mapomme à dit:
Bonjour pierrejean,

C'est une épidémie.

Après Magic_Doctor, toi aussi tu commencerais un Alzheimer ?

Bonne nuit.

ABDELHAK · 28 Août 2016

Bonjour pierrejean,

Désolé de vous répondre tardivement, merci pour les dernières lignes de codes que vous m’avez envoyées. La macro fonctionne parfaitement.

J’ai, également, essayé de bidouiller la macro VIDER LES NON VERTS ET DECALER V3 mais hélas sans succès. Je suis un peu déçu mais c’est quasiment du chinois.

En effet, j’ai essayé qu’elle efface les cellules vertes et qu’elle garde les cellules sans remplissage. En somme qu’elle exécute le contraire.

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

1000 mercis

A bientôt

ABDELHAK

job75 · 29 Août 2016

Re,

ABDELHAK à dit:
En effet, j’ai essayé qu’elle efface les cellules vertes et qu’elle garde les cellules sans remplissage. En somme qu’elle exécute le contraire.

Il n'est pas bien difficile de modifier la macro que j'ai donnée :

Code:

Sub FiltreCouleur()
'nom défini en A1 => Couleur =LIRE.CELLULE(38;Feuil1!A1)
'cellules W2 et W5 nommées Code et Minimum
Dim dur#, ncol%, n&, a$
dur = Timer
Application.ScreenUpdating = False
[A1].CurrentRegion.EntireColumn.Copy [Y1] 'Y1 à adapter
With [Y1].CurrentRegion.Offset(1, 1)
  ncol = .Columns.Count
  '---effacement des cellules colorées---
  .Resize(, ncol - 1) = "=REPT(B2,Couleur<>Code)"
  '---concaténation en colonne Z et conversion de données---
  For n = 1 To ncol - 1
    a = a & "&"" ""&RC[" & n - ncol & "]"
  Next
  ThisWorkbook.Names.Add "concat", "=" & Mid(a, 6) 'nom défini
  .Columns(ncol) = "=TRIM(concat)"
  .Columns(ncol) = .Columns(ncol).Value
  .Columns(1) = .Columns(ncol).Value
  .Columns(2).Resize(, ncol - 2) = "" 'RAZ
  .Resize(, ncol - 1).Interior.ColorIndex = xlNone 'RAZ
  .Columns(1).TextToColumns .Cells(1), xlDelimited, Space:=True
  '---suppression des lignes < Minimum---
  .Columns(ncol) = "=LN(COUNTA(RC[" & 1 - ncol & "]:RC[-1])>=Minimum)"
  .Columns(ncol) = .Columns(ncol).Value
  .Columns(0).Resize(, ncol + 1).Sort .Columns(ncol), xlAscending, Header:=xlNo 'tri pour accélérer
  n = Application.Count(.Columns(ncol))
  .Columns(ncol) = ""
  .Cells(n + 1, 0).Resize(Rows.Count - n - .Row + 1, ncol).Delete xlUp
End With
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - dur, "0.00 \s") & vbLf & vbLf & _
  Application.Max([A1].CurrentRegion.Rows.Count - 1 - n, 0) & " ligne(s) supprimée(s)"
End Sub

Fichier (2).

Edit : le tableau source a été trié par dates pour qu'on puisse s'y retrouver.

Re-bonne nuit.

job75 · 30 Août 2016

Bonjour le fil, le forum,

S'il y a des textes avec des espaces il faut d'abord remplacer les espaces, par exemple par des espaces insécables de code 160.

Cela prend bien sûr un peu plus de temps.

Fichiers joints.

Bonne journée.

mapomme · 30 Août 2016

Bonjour ABDELHAK,

J'ai oublié de publier la version qui conserve les cellules non vertes.

ABDELHAK · 30 Août 2016

Bonjour job75

Désolé de vous répondre tardivement et merci pour la macro VIDER LES NON VERTS ET DECALER V4 elle fonctionne parfaitement .

Pour la macro FILTRE COULEUR, j’ai essayé plusieurs fois de l’exécuter le résultat elle ne garde que les cellules vertes. C’est juste pour vous informer. Comment faire pour garder les cellules sans couleurs.

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

1000 mercis

A bientôt

ABDELHAK

ABDELHAK · 30 Août 2016

Bonjour mapomm

Merci pour la macro CN TEST V5 elle fonctionne parfaitement. C’est to much.

A tous : je vous remercie pour votre aide. Grâce à votre savoir-faire : vous nous aider à donner forme à des rêves aussi loufoques soient-ils. Et cela n’a pas de prix.

Chapeau à votre compétence et perspicacité.

1000 mercis

A bientôt

ABDELHAK

mapomme · 31 Août 2016

Bonjour ABDELHAK,

J'ai amélioré la vitesse d'exécution de la v5 (cellule sans fond coloré) pour aboutir à la v5a. La durée d'exécution est presque divisée par 2 (sans atteindre toutefois la vitesse d'exécution de la solution de job75 ). Le code est un peu commenté.

ABDELHAK · 3 Septembre 2016

Bonjour mapomm

Merci pour la macro CN TEST V5a elle fonctionne parfaitement.

J’aimerais vous demander comment retiré la fonction MSGBOX de CN TEST V5a et CN TEST V3?

Si cette opération ne ralentit pas la vitesse d’exécution, bien entendu.

Je joins les 2 macros.

1000 mercis

A bientôt

ABDELHAK

SELECTION DE CELLULES

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

Discussions similaires