XL 2013 vba recherche selon champs (contient)

erwanhavre

XLDnaute Occasionnel
Bonjour à tous
Voir PJ j'aimerai une macro qui me copie les données qui sont dans les champs de recherche en feuil1 et qui requête la base de données qui est en feuil2 (et qui la filtre en même temps)
attention dans les champs de recherche je ne mets que des "bouts" c'est comme si on n'activai que les filtres avec ce qui est contenu
merci pour votre aide
 

Pièces jointes

  • Classeur1.xlsx
    10.7 KB · Affichages: 9

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

Parce que je m'em***dais une autre proposition. Les données ne sont pas filtrées dans l'onglet Feuil2 mais renvoyées dans l'onglet Feuil3 :

VB:
Sub Macro1()
Dim F1 As Worksheet 'déclare la variable F1 (onglet Feuil1)
Dim F2 As Worksheet 'déclare la variable F2 (onglet Feuil2)
Dim F3 As Worksheet 'déclare la variable F3 (onglet Feuil3)
Dim TV1(1 To 8) As String 'déclare la variable TV1 (Tableau des Valeurs de l'onglet F1)
Dim TV2 As Variant 'déclare la variable TV2 (Tableau des Valeurs de l'onglet F2)
Dim TEST As Boolean 'déclare la variable TEST
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)

Set F1 = Worksheets("Feuil1") 'définit l'onglet F1
For I = 1 To 8 'boucle sur les 8 informations
    TV1(I) = F1.Cells(I, "B") 'définit l'information de la boucle (donnée en colonne "B" de la boucle)
Next I 'prochaine information
Set F2 = Worksheets("Feuil2") 'définit l'onglet F2
TV2 = F2.Range("A1").CurrentRegion 'définit le tableau des valeurs de l'onglet F2, TV2
Set F3 = Worksheets("Feuil3") 'définit l'onglet F3
'renvoie la première ligne du tableau TV2 dans A1 redimensionnée de l'onglet F3
F3.Range("A1").Resize(1, UBound(TV2, 2)).Value = Application.Index(TV2, 1)
F3.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données dans l'onglet F3
K = 1 'initialise la variable K
For I = 2 To UBound(TV2, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeur TV2 (en partant de la seconde)
    TEST = False 'réinitialise la varible TEST
    For J = 1 To 8 'boucle 2 : sur les 8 informations du tableau TV1
        If TV1(J) <> "" Then 'condition : si l'information de la boucle du tableau TV1 n'est pas vide
            'si le texte de l'information n'est pas contenu dans la colonne J de TV2, alors TEST est [vrai], sort de la boucle 2
            If InStr(1, TV2(I, J), TV1(J), vbTextCompare) = 0 Then TEST = True: Exit For
        End If 'fin de la condition
    Next J 'prochaine information de la boucle 2
    If TEST = False Then 'condition : si TEST est [faux]
        ReDim Preserve TL(1 To 8, 1 To K) 'redimensionne le tableau des lignes TL (8 lignes, K colonnes)
        For L = 1 To UBound(TV2, 2) 'boucle3 : sur toutes les colonnes L du tableau des valeurs TV2
            TL(L, K) = TV2(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV2 (=> transposition)
        Next L 'prochaine colonne de la boucle 3
        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 à 1, renvoie dans A2 redimensionnée de l'onglet F3 le tableau TL transposé
If K > 1 Then F3.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 927
Membres
101 842
dernier inscrit
seb0390