Filtre élabore

[C@thy]

Bonsoir le forum,

un collègue me pose une colle (voir fichier joint),

peut-on filtrer le tableau pour que seules les entités qui ont des croix partout (toutes les lignes bleu clair d'une entité) apparaissent?

En fait je ne crois pas, il me semble bien qu'il faut une macro, qu'en pensez-vous?

Merci pour vos appréciations.

Bises

C@thy

 

[Dormeur74]

Re : Filtre élabore

Si on peut le faire par macro, quelques lignes de code suffisent. Tu veux ?

 

[ERIC S]

Re : Filtre élabore

Bonjour cathy

sans ajouter une colonne intermédiaire cela semble difficile

 

[C@thy]

Re : Filtre élabore

Merci Dormeur74, oui, je veux bien

Merci Eric S, tu imagines le truc comment???
(je recherche toutes les solutions possibles, et un certain Ti m'a appris que la meilleure macro consiste à ne pas en écrire...
cela dit, je ne sais pas si la personne souhaite qu'on rajoute une colonne à son fichier)

Merci à vous deux, c'est sympa

Bises

C@thy

 

[Dormeur74]

Re : Filtre élabore

Tu as déjà une possibilité en effectuant un tri décroissant sur la colonne FcF. Reste à détruire toutes les lignes en-dessous.

 

[david84]

Re : Filtre élabore

Bonsoir,
à première vue je pense que tu as raison : tu devra passer par macro.
Ceci-dit, en lisant tes explications

Il ne doit y avoir dans le nouveau résultat que l'ensemble des lignes bleu foncé bleu clair où toutes les lignes bleu clair ont un X dans "FcF":
Dans l'exemple après le traitement il ne faut plus que les lignes 6,7 et 20,21,22 et 25,26,27,28,29,30 apparaissent.

, je ne comprends pas pourquoi les lignes 6,7,21 et 29 devraient être prises en compte.
A+

 

[ERIC S]

Re : Filtre élabore

Re

J'ai fait un essai en J2 et tiré

=SI(A2="";J1;NBVAL(DECALER(L2;0;0;EQUIV(MIN(A3:A23);A3:A23;0)))-NBVAL(DECALER(N2;0;0;EQUIV(MIN(A3:A23);A3:A23;0))))

après tu filtre sur 0

 

[kinel]

Re : Filtre élabore

bonsoir à tous

petite proposition de filtre avec userform
je l'ai adapté au problème soulevé ici mais j'ai utilisé cette forme de filtres sur des grosses listes en utilisant une dizaine de filtres différents
à l'époque j'avais bien été aidé par ce forum
je rends donc à césar...

amitiés
Kinel

 

[kinel]

Re : Filtre élabore

juste une petite précision

pour continuer à utiliser le classeur quand l'userform est ouvert il faut aller dans les propriétés de l'userform et à la ligne Showmodal mettre false

 

[Dormeur74]

Re : Filtre élabore

Une petite macro qui protège l'original.

 

[C@thy]

Re : Filtre élabore

Un grand merci à vous tous,

je suis effectivement passée par une macro...
je suis donc partie de celle de Dormeur74, mais sans copier le tableau,
j'ai juste masqué les lignes au lieu de les supprimer, ce qui conserve l'original. Au lieu du delete :

Selection.EntireRow.Hidden = True

Toutefois, il ne faut pas masquer les lignes génériques (bleu foncé) qui fournissent le code,
donc ce n'est pas encore tout à fait ça.

je regarde les autres solutions

Edit : David84 (coucou au passage!), tu as tout à fait raison, les lignes 6,7,21 et 29 ne doivent plus apparaître, c'est bien ça.

kinel : je dois conserver les lignes bleu foncé qui contiennent le code, donc le principe n'est pas celui-là.

ERIC S, ta solution fonctionne parfaitement. MERCIiiiiiiiiiiiiiiiiiiiiiii

Bises

C@thy

 

[job75]

Re : Filtre élabore

Bonjour C@thy, le forum,

J'y vais de ma solution VBA, si j'ai bien compris ce qu'il faut masquer :

Sub Masque() 'touches de raccourci Ctrl+M
Dim i&, h&
Application.ScreenUpdating = False
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Cells(i, "N").Interior.ColorIndex = 34 Then h = h + 1 'bleu clair
  If Cells(i, "N").Interior.ColorIndex = 37 Then 'bleu foncé
    If h Then
      Rows(i).Resize(h + 1).Hidden = Application.CountA(Cells(i + 1, "N").Resize(h)) < h
      h = 0
    Else
      Rows(i).Hidden = True
    End If
  End If
Next
End Sub

Sub Affiche() 'touches de raccourci Ctrl+A
Rows.Hidden = False
End Sub

Fichier joint.

Nota : les lignes 39 à 43 se masquent aussi.

Si l'on met un X en N42 elles ne se masquent pas.

A+

 

[job75]

Re : Filtre élabore

Re,

Si une ligne bleu foncé est toujours suivie d'au moins une ligne bleu clair, le code se simplifie :

Sub Masque() 'touches de raccourci Ctrl+M
Dim i&, h&
Application.ScreenUpdating = False
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Cells(i, "N").Interior.ColorIndex = 34 Then h = h + 1 'bleu clair
  If Cells(i, "N").Interior.ColorIndex = 37 Then 'bleu foncé
    Rows(i).Resize(h + 1).Hidden = Application.CountA(Cells(i + 1, "N").Resize(h)) < h
    h = 0
  End If
Next
End Sub

Fichier (2).

Edit : ah oui pour les 2 macros il est plus prudent de ne pas traiter la ligne 1 (For... To 2)...

A+

 

[C@thy]

Re : Filtre élabore

Bonjour Gérard, très heureuse de te revoir 😉

merci pour ce boulot. Bravo, c'est super génial ton masquahe avec les touches ctrl+M et ctrl+A.

J'ai eu quelques précisions supplémentaires de l'utilisateur :

ce qu'il souhaite :
feuille 1 la base inchangée
feuille 2 l'extraction des lignes qui ont des croix partout
feuille 3 les autres
je joins le fichier exemple.

Donc en fait, c'est le même principe sauf qu'on copie sur une feuille ou l'autre suivant si toutes les lignes bleu clair d'un même bleu foncé ont une crois ou non.

Bisous bisous, et merci encore, job75!!!

P.S. oui une ligne bleu foncé est toujours suivie d'une bleu clair🙂

Edit : il y a bien un X en N42!!!

C@thy

 

[job75]

Re : Filtre élabore

Re,

Tiens dans ce fichier les "X" sont en colonne M 🙂

Voici la macro précédente adaptée pour créer 2 zones de tranfert R1 et R2 :

Sub Tri() 'touches de raccourci Ctrl+T
'on utilise le CodeName des feuilles
Dim R1 As Range, R2 As Range, i&, h&
With Feuil1
  Set R1 = .[1:1]: Set R2 = .[1:1]
  For i = .UsedRange.Rows.Count To 2 Step -1
    If .Cells(i, "M").Interior.ColorIndex = 34 Then h = h + 1 'bleu clair
    If .Cells(i, "M").Interior.ColorIndex = 37 Then 'bleu foncé
      If Application.CountA(.Cells(i + 1, "M").Resize(h)) = h Then
        Set R1 = Union(R1, .Rows(i).Resize(h + 1))
      Else
        Set R2 = Union(R2, .Rows(i).Resize(h + 1))
      End If
      h = 0
    End If
  Next
End With
Feuil2.Cells.Clear: Feuil3.Cells.Clear 'RAZ
R1.Copy Feuil2.[A1]: R2.Copy Feuil3.[A1]
End Sub

Fichier joint.

A+