Filtrer un tableau dynamique de recherche

Bonjour à tous !

Après beaucoup d'aides demandées ici, le fichier excel que j'ai créé pour filtrer selon des critères et le stock de milliers de variétés de légumes fonctionnent à merveille !
Il me reste juste un détail à ajouter auquel je n'ai pas pensé, tout simplement rechercher directement une variété pour connaitre le stock.
Le bon vieux CTR+F et on tape me suffit mais mes compères pas du tout fans d'informatique c'est pas pratique.

J'ai donc décidé d'jouter un bout de VBA qui permettrait de filtrer dynamiquement mon tableau dynamique. En gros je tape des caractères et dans le tableau dynamique ne reste que ce qui correspond (qui contient la chaine de caractère).
En fouillant un peu sur le forum et le site je suis tombé sur ce bout de code (mon tableau dynamique commençant en B10), qui fonctionne bien mais se contente de surligner en vert les possibilités (et au passage flinguer la mise en forme de mon tableau ^^) :

Option Compare Text
Private Sub TextBox1_Change()

    Application.ScreenUpdating = False

    Range("B10:A1600").Interior.ColorIndex = 2

    If TextBox1 <> "" Then
        For ligne = 10 To 1600
            If Cells(ligne, 2) Like "*" & TextBox1 & "*" Then
                Cells(ligne, 2).Interior.ColorIndex = 43            
            End If
        Next
    End If

End Sub

Cela fonctionne bien mais je suis loin d'avoir l'effet escompté. Peut-on se baser dessus pour avoir une recherche dynamique ou cela n'a rien à voir ? car là je cherche selon une colonne bêtement donc là vu que c'est censé modifié l'affichage du tableau dynamique je pense que c'est pas du tout par là qu'il faut commencer.

Merci d'avance !

Hello,

Oui tu peux te baser dessus, par contre il te faut ajouter un textbox dans ta feuille avec ce code.

Private Sub TextBox1_Change()

Voici quelques commentaires à ton code pour que tu comprennes :

Option Compare Text 'comparaison insensible à la casse.
Private Sub TextBox1_Change() 'A chaque changements dans le textbox

    Application.ScreenUpdating = False 'Enlève le rafraichissement de l'écran

    Range("B10:A1600").Interior.ColorIndex = 2 ' Mets la couleur 2 en arrière plan des cellules allant de B10 à A1600

    If TextBox1 <> "" Then 'Si le textbox n'est pas vide
        For ligne = 10 To 1600 'De la ligne 10 à la ligne 1600
            If Cells(ligne, 2) Like "*" & TextBox1 & "*" Then 'Si on trouve qqch qui ressemble à ce qui est saisi dans le textbox
                Cells(ligne, 2).Interior.ColorIndex = 43  ' On ajoute une couleur de fond (43) à la cellule B & la valeur de ligne      
            End If
        Next
    End If

End Sub

Merci pour la réponse.
en effet c'est bien plus clair, mais maintenant si je souhaite que mon tableau dynamique ne garde que les termes correspondant au lieu de les surligner, là je coince ^^

Par exemple ceci, qui masque les lignes si elles ne correspondent pas.

Option Compare Text 'comparaison insensible à la casse.
Private Sub TextBox1_Change() 'A chaque changements dans le textbox

    Application.ScreenUpdating = False 'Enlève le rafraichissement de l'écran

    Range("B10:A1600").Interior.ColorIndex = 2 ' Mets la couleur 2 en arrière plan des cellules allant de B10 à A1600

    If TextBox1 <> "" Then 'Si le textbox n'est pas vide
        For ligne = 10 To 1600 'De la ligne 10 à la ligne 1600
            If not Cells(ligne, 2) Like "*" & TextBox1 & "*" Then 'Si on trouve qqch qui ressemble à ce qui est saisi dans le textbox
                 rows(ligne).EntireRow.Hidden = true
            ELSE
             rows(ligne).EntireRow.Hidden = false
             End If
        Next
    End If

End Sub

NON TESTE

Super cela marche nickel !
Cependant, il y a 3 petits points dont un très embêtant ^^

1- Parcourir les 1600 lignes à chaque fois qu'on entre un caractère cela fait ramer excel à fond, peut-on plutôt faire en sorte que l'on tape et on y met un bouton rechercher pour que la recherche ne se lance que là.

2-Si j'efface caractère par caractère la recherche se fait bien ce qui restaure des lignes au fur et à mesure mais lorsque j'efface le dernier caractère, la liste reste comme elle était à l'avant dernier.

3- J'ai un gros bouton qui me permet de réinitialiser les filtres et au passage d'enlever les photos (oui car si on fait double clic sur une variété du tableau, la photo de cette variété s'affiche à côté, donc en cas de double clic sur un autre nom j'ai inclu dans ma VBA un bout qui supprime toutes les images de la feuille avant d'en afficher une autre). Ce qui du coup au passage ... enlève aussi le TextBox.

Dim Img As Object 'On supprime toutes les images de la feuille avant de continuer
For Each Img In ActiveSheet.Pictures
    Img.Delete
Next Img

Merci encore d'avance énormément, cela va être tellement plus simple si c'est possible de corriger ces 3 petits points ^^

Mais pourquoi tu n'utilises pas les filtres tout simplement en mode graphique d'excel ?

C'est à dire ?

En fait je pense que cela ne soit pas compatible réellement avec l'usage sur le lieu de l'exposition (le fichier doit servir en quelques secondes à sortir un résultats que ce soit part les filtres et segments ou la barre de recherche), résultats sur lequel on clic et la photo apparait.
D'où le fait de passer obligatoirement par le VBA.

C'est pas tres clair ce que tu souhaites faire mais c'est vrai que le fait de cacher les lignes est long ...

Je te conseil d'utiliser les filtres en VBA comme ceci :

Columns(1).AutoFilter field:=1, Criteria1:=[A1]

Ce code filtre la colonne A de la feuille active avec comme critère le contenu de la cellule A1 de la feuille active.

Tu peux l'adapter à la valeur d'un textbox par exemple et la colonne que tu souhaites.

Attention avec cette méthode, il faut bien s'assurer que les filtres soient actifs sur la colonne en question

Salut !
je viens de trouver un bout de code qui marche parfaitement :

 Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Stock restant").PivotTables("STOCK")
    Set xPFile = xPTable.PivotFields("Nom")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub
   

Le problème c'est que il faut entrer exactement le bon nom en A1 pour que cela trouve mais il faudrait juste chercher des correspondances des caractères saisies au lieu de la totalité du mot. Peut-on modifier ceci pour l'intégrer ?

Hello,

As tu essayé de taper 3 caractères en A1 et de faire tabulation ?

Bonsoir,
Non j'avoue ne pas y avoir pensé, mais j'ai finalement trouvé une solution peut être que je me suis cassé la tête mais voilà :

 Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Stock restant").PivotTables("STOCK")
    Set xPFile = xPTable.PivotFields("Nom")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

Pour que le A2 se mettre à jour j'ai mis une liste déroulante (Contrôle active X) en soit joue très bien le rôle de barre de recherche ainsi qu'un bouton vert au bout 'ok'

Sub ok()
Range("A2").Value = Range("A1").Value
Call Rafraichissement
End Sub

Je voulais juste rafraichir la page en faisant ok, mais il se trouve que là où écrit la liste déroulante cela n'est pas pris en compte par le premier code en haut, donc j'ai contourné et demandé à ce que la cellule soit copiée vers A2 et là ca fonctionne (si je paramètre la liste déroulante pour qu'elle donne le résultat direct en A2 ca fonctionne pas).