Find (sans quitter le filtrage en cours)

Pour tester, mettez cette ligne juste avant le set Plage

Sheets(k).Cells.EntireRow.Hidden = False

Re Dan :

Malheureusement ça n'affiche toujours le N° en seconde recherche :)

Essayez le fichier joint. Je ne vois pas de soucis

Re Dan,

Quel courage merci et ça fonctionne super !

Cette solution est différente de celle de BsAlv qui n'est pas encore tout à fait aboutie :) (j'essaie de trouve ce qui me manque)

Me voilà avec 2 solutions et presque 3 avec celle de ThauThème ... lol la classe pour un sujet difficile à résoudre.

Merci Dan pour ta patience :)

lionel :)

"Cette solution est différente de celle de BsAlv qui n'est pas encore tout à fait aboutie :) (j'essaie de trouve ce qui me manque)"
voir 18:57 !!! (il y a 4 heures)

Re BsAlv :)

Je rectifie lol quand je dis pas aboutie, elle est et fonctionne mais pas tout à fait pour mon besoin.

Je ne vois pas de post à 18h57

C'est cette ligne que je n'avais pas vu : If Len(nom) > 0 Then Montrer CStr(nom)

Je teste :)

Re BsAlv :)
Nickel aussi :)

et merci à tous ceux qui m'ont aidé :)

bonjour,

super !!!

2 points de reflections

1. au début du code "arr = .UsedRange.Value2",

remplacer Usedrange par la plage des données

2. le code bloque avec des erreur dans la plage

Bonjour le Forum, gon dimanche à toutes et à tous :)

Bonjour BsAlv :)

1 - "Remplacer Usedrange par la plage des données"

(arr = .UsedRange.Value2 'la plage à inspecter (ici toute la feuille) >>> array)

La plage est bien toute la feuille dois-je remplacer par, par exemple : ("a6:zz10000") ?

2. "le code bloque avec des erreurs dans la plage"

J'ai pas vu de beug, les n° cherchés sont bien trouvés et les lignes affichées.

Pour toi, ça se manifeste comment ?

lionel :)

Re-Bonjour BsAlv :)

J'ai remplacé "arr = .UsedRange.Value2" par "arr = [a6:zz10000].Value2]"

J'ai lancé la recherche et "Excel ne répond plus = j'ai quitté sauvagement au bout de 3 minutes

lionel :)

10.000 lignes * 700 colonnes

j'ai ajouter le progres sur le statusbar, 2 lignes par seconde = 5.000 sec ?

si vous voulez limiter la recherche a quelque colonnes de ces 700, le macro sera plus vite.

Sub Montrer(sTexte)
Set dict = CreateObject("scripting.dictionary")
With Sheets("Appels")
arr = .Range("A6:ZZ10000").Value2 'la plage à inspecter (ici toute la feuille) >>> array

For i = 1 To UBound(arr) 'boucle les lignes
DoEvents
Application.StatusBar = i

dict.Add dict.Count, Range("Myrange")(i, 1).Address & "|" & Join(Application.Index(arr, i, 0), "|") 'ajouter au dictionary : l'addresse de la cellule A & le contenu de toute la ligne
Next
Application.StatusBar = ""
fl = Filter(Application.Index(dict.items, 0, 0), sTexte, 1, vbTextCompare) 'filtre les lignes avec le texte voulu
If UBound(fl) > -1 Then 'il y a des lignes comme-çà
Set UN = .Range("B1") 'une cellulle dehors colonne A
For i = 0 To UBound(fl) 'boucle toutes ces lignes
Set UN = Union(UN, .Range(Split(fl(i), "|")(0))) 'ajouter au place "UN"
Next
Set UN = Intersect(UN, .Columns("A"))
'MsgBox UN.Address & vbLf & .ProtectionMode '& vbLf & .protectcontents
If Not .ProtectionMode And .ProtectContents Then
.Unprotect
.Protect userinterfaceonly:=True
End If
UN.EntireRow.Hidden = False
End If

End With
End Sub

Re-Bonjour BsAlv :)

Je te remercie pour ce nouveau code :)

Malheureusement difficile à utiliser en situation de travail pour rechercher dans ("k6:k500"), c'est déjà plusieurs secondes.

Egalement, il ne fonctionne pas à partir de la 2eme recherche (ne trouve pas le n°)

Le précédent fonctionne bien mieux, trouve tout et est instantané.

Sub Montrer(sTexte)
     Set dict = CreateObject("scripting.dictionary")
     Sheets("Appels").Select
     With Sheets("Appels")
        arr = .UsedRange.Value2 'la plage à inspecter (ici toute la feuille)  >>> array
        For i = 1 To UBound(arr) 'boucle les lignes
            dict.Add dict.Count, Range("Myrange")(i, 1).Address & "|" & Join(Application.Index(arr, i, 0), "|")
            'ajouter au dictionary : l'addresse de la cellule A & le contenu de toute la ligne
        Next
        fl = Filter(Application.Index(dict.items, 0, 0), sTexte, 1, vbTextCompare)
        'filtre les lignes avec le texte voulu
        If UBound(fl) > -1 Then 'il y a des lignes comme-çà
            Set UN = .Range("B1") 'une cellulle dehors colonne A
            For i = 0 To UBound(fl) 'boucle toutes ces lignes
                Set UN = Union(UN, .Range(Split(fl(i), "|")(0))) 'ajouter au place "UN"
            Next
            Set UN = Intersect(UN, .Columns("A"))
    'MsgBox UN.Address & vbLf & .ProtectionMode '& vbLf & .protectcontents
            If Not .ProtectionMode And .ProtectContents Then
                .Unprotect
                .Protect userinterfaceonly:=True
            End If
            UN.EntireRow.Hidden = False
        End If
     End With
End Sub

2. "le code bloque avec des erreurs dans la plage"

De mon côté, je n'ai pas vu de beug.

Je ne comprends pas qu'il y ait beug chez toi :)

lionel :)

Bonjour le fil, bonjour le forum,

Bien poli et lustré, parfait pour mon canon...

Bonjour ThauThème :)

Que dois-je comprendre ? lol

J'ai fait une bêtise ?

lionel :)

Bonjour Dan :)

Tests et re-tests ... ton fichier fonctionne nickel bien !

Encore merci :)

Bonjour

Pas de souci. Seul truc comme je vous ai dit avant, les instructions "Application.enableevents", vous pouvez les supprimer. Elles ne servent pas dans votre cas

De base, j'évite toujours cette instruction qui suspend les macro dites événementielles (je parle des private sub qui se trouvent dans les feuilles ou Thisworkbook).
Si le code se plante après cette instruction votre fichier perdra sa gestion d'évènements VBA et plus aucune procédure évènementielle ne se déclenchera automatiquement pendant que vous continuez de travailler....Vous êtes alors obligé de fermer excel
Heureusement que Microsoft a prévu aujourd'hui de les remettre à disposition à la réouverture car dans les anciennes versions d'excel vous perdiez complétement cette fonctionnalité, mais si vous n'avez rien sauvegardé, bonjour les dégâts...

Cordialement

voici mon canon et la première ligne, ce sont les colonnes à inspectées

Const MesColonnes = "1, 2, 3, 4, 5, 6, 7, 8, 11,100, 200, 300, 400, 500, 600, 700" '---->ces colonnes de la plage "LIOB2" doivent etre inspectées

Sub teste()
Montrer "331"
End Sub

Sub Montrer(sTexte)
t = Timer
sp = Split(MesColonnes, ",")
With Sheets("Appels")
.Range("A6:ZZ10000").Name = "liob2" 'la plage à inspecter (ici toute la feuille) >>> array
Set un = .Range("B1") 'une cellulle dehors colonne A

For i = 0 To UBound(sp) 'boucle les colonnes sélectionnées
Application.StatusBar = sp(i)
arr = Evaluate("row(Offset(liob2, , " & sp(i) - 1 & ", , 1)) & ""|"" & Offset(liob2, , " & sp(i) - 1 & ", , 1)") 'numéro de ligne & contenu de la cellule
If UBound(arr) > 65000 Then MsgBox "gros problème" 'probleme de transpose au dessus de 65.000
fl = Filter(Application.Transpose(arr), sTexte, 1, vbTextCompare) 'filtrer toutes les cellules qui commencent avec ce sTexte
If UBound(fl) > -1 Then 'il y a des lignes comme-çà
For j = 0 To UBound(fl) 'boucle toutes ces lignes
sp1 = Split(fl(j), "|")
If InStr(1, sp1(1), sTexte, 1) > 0 Then Set un = Union(un, .Range("A" & Split(fl(j), "|")(0))) 'ajouter au place "UN"
'MsgBox un.Address
Next
Set un = Intersect(un, .Columns("A"))
End If
Next
Application.StatusBar = ""

If Not .ProtectionMode And .ProtectContents Then
.Unprotect
.Protect userinterfaceonly:=True
End If
un.EntireRow.Hidden = False
End With
MsgBox "pret en " & Format(Timer - t, "0.0\s")
End Sub

@ Dan :)
Merci pour les explications.
Dans mon fichier de travail, les "Application.enableevents" me sont utiles;
J'aurais du les enlever pour le fichier test.
lionel :)
Vous êtes alors obligé de fermer excel

alors on ajoute un macro et on le lance
Sub Eon()
     Application.EnableEvents = True
End Sub

Re BsAlv :)

Merci pour ce nouveau fichier :)

image
Rechercher des sujets similaires à "find quitter filtrage cours"