Extraire les valeurs d'un filtre dans un autre onglet

Le 04/07/2016 à 12:46

Bonjour,

Je souhaiterais effectuer un filtre sur un mot dans la colonne B onglet "Liste" du tableau en pièce jointe et ensuite coller les valeurs filtrées de la colonne A dans l'onglet "Results".

Je pense que ce n'est pas très compliqué mais je n'arrive pas à trouver de solution...

Merci d'avance pour votre aide.

30toto.zip (38.04 Ko)
Le 04/07/2016 à 14:04

Bonjour Nuns, bonjour le forum,

En pièce jointe ton fichier modifié avec une UserForm et une ComboBox. Sélectionne un matériel dans la ComboBox1 pour filtrer...

Le code :

Private L As Worksheet 'déclare la variable L (onglet Liste)
Private R As Worksheet 'déclare la variable R (onglet Results)
Private TV As Variant 'déclare la variable TV (Tableau des Valeurs)

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)

Set L = Worksheets("Liste") 'définit l'onglet L
Set R = Worksheets("Results") 'définit l'onglet R
TV = L.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    D(TV(I, 2)) = "" 'alimene le dictionnaire D avec les données en colonne 2 du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
Me.ComboBox1.List = D.Keys 'alimente la ComboBox1 avec la listes des éléments du dictionnaire D sans doublon
End Sub

Private Sub ComboBox1_Change() 'au changement dans la ComboBox1
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)

R.Range("A1").CurrentRegion.ClearContents 'efface des éventuelles anciennes données dans l'onglet R
R.Range("A1").Resize(1, 2).Value = Application.Index(TV, 1) 'renvoie dans A1 redimensionnée la première ligne du tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    If TV(I, 2) = Me.ComboBox1 Then 'condition : si la donnée ligne I colonne 2 de TV est égale à la valeur de la ComboBox1
        ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
        TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (=transposition)
        TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV (=transposition)
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'si K est supérieure à un (au moins une occurrence trouvée), renvoie dans A2 redimensionnée le tableau TL transposé
If K > 1 Then R.Range("A2").Resize(UBound(TL, 2), 2) = Application.Transpose(TL)
Unload Me 'vide et ferme l'UserForm1
End Sub

Le fichier :

43nuns-v01.xlsm (63.80 Ko)
Le 04/07/2016 à 15:01

Bonjour ThauThème,

Merci beaucoup pour ce fichier !!

J'avais manqué de précision, en fait j'ai besoin de faire des filtres avec un texte choisi.

Par exemple, si dans la colonne 2 j'ai les textes suivants :

  • jus de pomme
  • pomme
  • banane
  • jus de banane
  • banane séchée
  • tomate

=> si je cherche "jus" je récupère "jus de pomme" & "jus de banane" et si je cherche banane je récupère "banane", "banane séchée" & "jus de banane".

Merci !!

EDIT : question bête, mais il est où le code dans le fichier?

Le 04/07/2016 à 15:22

Bonjour,

il faut juste changer le "if ..... = ..." par "if ... Like ..." ou "il ..... = "*...*"

pour trouver le code il faut aller dans :

Affichage/Macros/Afficher les macros

Le 04/07/2016 à 15:37

Bonjour Minanse,

Pour l'affichage des macros en fait c'était dans un userform, je ne connais pas ça, c'est pour ça que je ne trouvais pas le code.

Ca ne fonctionne pas non plus de remplacer "if ..... = ..." par "if ... Like ..." ou "il ..... = "*...*"

En effet, le bouton propose une liste, on ne peut pas taper de texte à rechercher avec ce modèle.

Merci !

Le 04/07/2016 à 15:53

à tester

rempalcer sa

 If TV(I, 2) = Me.ComboBox1

par

 If Ucase(TV(I, 2).value) like ucase(Me.ComboBox1.text)
Le 04/07/2016 à 18:21

Rebonjour,

J'ai trouvé une solution !

Voilà le code finalisé :

Private L As Worksheet 'déclare la variable L (onglet Liste)
Private R As Worksheet 'déclare la variable R (onglet Results)
Private TV As Variant 'déclare la variable TV (Tableau des Valeurs)

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)

Set L = Worksheets("Liste") 'définit l'onglet L
Set R = Worksheets("Results") 'définit l'onglet R
TV = L.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    D(TV(I, 2)) = "" 'alimene le dictionnaire D avec les données en colonne 2 du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
'Me.ComboBox1.List = D.Keys 'alimente la ComboBox1 avec la listes des éléments du dictionnaire D sans doublon
End Sub

'Private Sub TextBox1_Change() 'au changement dans la ComboBox1
'Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
'Dim I As Integer 'déclare la variable I (Incrément)
'Dim K As Integer 'déclare la variable K (incrément)

'R.Range("A1").CurrentRegion.ClearContents 'efface des éventuelles anciennes données dans l'onglet R
'R.Range("A1").Resize(1, 2).Value = Application.Index(TV, 1) 'renvoie dans A1 redimensionnée la première ligne du tableau des valeurs TV
'K = 1 'initialise la variable K
'For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
 '   If TV(I, 2) = "*" & Me.TextBox1 & "*" Then 'condition : si la donnée ligne I colonne 2 de TV est égale à la valeur de la ComboBox1
 '       ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
 '       TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (=transposition)
 '       TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV (=transposition)
 '       K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
 '   End If 'fin de la condition
'Next I 'prochaine ligne de la boucle
'si K est supérieure à un (au moins une occurrence trouvée), renvoie dans A2 redimensionnée le tableau TL transposé
'If K > 1 Then R.Range("A2").Resize(UBound(TL, 2), 2) = Application.Transpose(TL)
'Unload Me 'vide et ferme l'UserForm1
'End Sub

Private Sub CommandButton1_click()

Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)

R.Range("A1").CurrentRegion.ClearContents 'efface des éventuelles anciennes données dans l'onglet R
R.Range("A1").Resize(1, 2).Value = Application.Index(TV, 1) 'renvoie dans A1 redimensionnée la première ligne du tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    If UCase(TV(I, 2)) Like "*" & UCase(Me.TextBox1) & "*" Then 'condition : si la donnée ligne I colonne 2 de TV est égale à la valeur de la TextBox1
        ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
        TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (=transposition)
        TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV (=transposition)
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'si K est supérieure à un (au moins une occurrence trouvée), renvoie dans A2 redimensionnée le tableau TL transposé
If K > 1 Then R.Range("A2").Resize(UBound(TL, 2), 2) = Application.Transpose(TL)
Unload Me 'vide et ferme l'UserForm1
End Sub

Bien sur je n'ai plus une liste mais une textbox maintenant.

Merci à tout les deux.

Le 05/07/2016 à 09:08

Bonjour le fil, bonjour le forum,

Désolé de ne pas être intervenu plus tôt, problèmes de connexion...

Oui Nuns, c'est exactement ça ! Avec une TextBox au lieu de la ComboBox... Je préfère InStr au Like...

40nuns-v02.xlsm (62.12 Ko)
Rechercher des sujets similaires à "extraire valeurs filtre onglet"