Microsoft 365 Filtre direct sans formuler

Usine à gaz · 15 Mars 2023

Bonjour à toutes et à tous

Je bute sur un filtrage que je n'arrive pas à coder comme je le souhaite.
J'ai fait un petit code pour faire un filtre.

VB:

Sub lio()
    [H7].FormulaR1C1 = "=IF(ISERROR(SEARCH(""lio "",RC[-7])),""Mot non trouvé"",""lio "")"
    [H7].Copy
    Range("H8:H20").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    For i = 7 To Range("h" & Rows.Count).End(xlUp).Row
        If Cells(Cells(i, 1).Row, 8) <> "lio " Then Rows(i).Hidden = True
    Next i
    [H7:h20].ClearContents
    [a1].Select
End Sub

Mon objectif est de ne laisser apparaître que les lignes qui contiennent "dans la chaine" en col A "lio "
Je passe pas un calcul que je fais en col H
Ce calcul doit ce faire sur toutes les lignes col A "NON VIDES"

Voici mon souci :
ça fonctionne mais dans mon fichier de travail, environ 40.000 lignes, ça me semble lourd.
Et toutes mes colonnes sont occupés sur environ 30 colonnes

Je pourrais fait le calcul dans une colonne loin, loin…. et ensuite l'effacer
Mais ce sont les opérations que je souhaite éviter pour alléger le temps de filtrage.

Est-il possible de faire plus directe, si possible dans passer par une formule ?
Je n'ai pas trouvé comment coder en direct : si col A contient "lio " = filtre

Auriez-vous le bon code ?
En cas, je joins le petit fichier test.

Un grand merci à toutes et à tous,

vgendron · 15 Mars 2023

bonjour

ce n'est pas vraimet un filtre que tu fais.. tu masques des lignes
pourquoi ne pas utiliser les fonctions d'excel??

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1, Criteria1:="=*lio*", Operator:=xlAnd

Lolote83 · 15 Mars 2023

Salut @Usine à gaz
Je suppose que tes données ont une entête.
En utilisant les filtres et la macro suivante ça peut le faire
@+ Lolote83

sylvanu · 15 Mars 2023

Bonjour Lionel,
[Oups! P***n de refresh] Bonjour Vgendron, Lolotte.
Encore une usine à gaz ?
Ne serait ce pas suffisant de mettre un filtre en place puis ensuite de le piloter en VBA ?

Code:

Sub Filtre()
    Application.ScreenUpdating = False
    ActiveSheet.Range("$A$6:$I$100000").AutoFilter Field:=1, Criteria1:="=*lio*", Operator:=xlAnd
End Sub
Sub Défiltre()
    Application.ScreenUpdating = False
    ActiveSheet.Range("$A$6:$I$100000").AutoFilter Field:=1
End Sub

Mais avec 40000 lignes .....

vgendron · 15 Mars 2023

e n'ai pas trouvé comment coder en direct : si col A contient "lio " = filtre

moi je viens de le faire en 4s en utilisant l'enregistreur de macro.. depuis le temps. je pense que tu connais...

sylvanu · 15 Mars 2023

Soyez tolérant, Lionel n'est inscrit que depuis le 13 Décembre 2011.
Soit à peine plus de 4100 jours, laissez lui le temps de percuter. ( il doit avoir des origines suisses )

Usine à gaz · 15 Mars 2023

Bonjour vgendron, Bonjour Lolote83, Bonjour sylvanu

Mais oui, où j'avais la tête lol
Merci à vous tout fonctionne

Non Sylvanu moqueur, je ne suis pas suisse ... peut-être un peu vieux lol

job75 · 15 Mars 2023

Bonjour Lionel, le fil,

Pour tester ton fichier j'ai copié la plage A7:B20 sur 42 000 lignes; puis la colonne B sur 30 colonnes.

Enfin exécuté ces 2 macros :

VB:

Sub Filtre()
Dim t
t = Timer
[A6].CurrentRegion.AutoFilter 1, "*lio*"
MsgBox Timer - t
End Sub

Sub Sup_Filtre()
Dim t
t = Timer
ActiveSheet.ShowAllData
MsgBox Timer - t
End Sub

Chez moi la 1ère s'exécute en 0,04 seconde, la 2ème est instantanée.

Donc aucune lourdeur.

A+

Usine à gaz · 15 Mars 2023

Bonsoir Gérard
Merci pour ton code nickel comme toujours.

job75 · 15 Mars 2023

Au post #8 j'ai ajouté le fichier compressé.

Usine à gaz · 15 Mars 2023

Re-Gérard
0.10 chez moi au filtrage
2ème est instantanée
Fulgurant !!!
Merci à toi

patricktoulon · 16 Mars 2023

bonjour
je pense qu'il faut changer les barrettes mémoire de Lionel
ça urge maintenant

Microsoft 365 Filtre direct sans formuler

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

vgendron

XLDnaute Barbatruc

Pièces jointes

Lolote83

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

vgendron

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires