Extraire des données d'un tableau excel par liste de mots clefs

TOTOEXCEL2019

XLDnaute Nouveau
Bonjour,

Voici le principe de la macro VBA actuelle : elle permet de rechercher dans le tableau de la "Feuil1" un critère, puis extrait dans une nouvelle feuille les lignes qui y sont rattachées.

Je voudrais savoir s'il est possible de la faire évoluer un peu.

En effet, il serait bien de rechercher dans le tableau de la "Feuil1" une liste de critères (présent par exemple dans l'onglet "Liste"), puis de générer une nouvelle feuille comportant les lignes identifiées par la liste de la recherche.

En d'autres termes, cela permettrait de passer d'une recherche monocritère à multicritères via une liste de mots clefs.

Je vous joins la macro VBA actuelle ainsi que l'onglet "Liste" ajouté pour faire la recherche.


Merci par avance.
 

Pièces jointes

  • Test 2.xls
    68 KB · Affichages: 36

mapomme

XLDnaute Barbatruc
Supporter XLD
Merci pour cet essai, cela semble fonctionner jusqu'à la colonne "F";
cependant pourquoi la colonne "G" n'apparaît-elle pas dans le "result" ? Cela décale les autres d'un rang.

Parce que dans le fichier fourni au message #1, les données s'arrêtent à la colonne F. J'ai utilisé la colonne G pour la formule de filtrage.
J'ai fait en fonction du fichier fourni.
 

BOISGONTIER

XLDnaute Barbatruc
Bonjour,

Avec le filtre élaboré


VB:
Sub FiltreInverseListe()
    Sheets("bd").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, _
       CriteriaRange:=Range("A1:A2"), Unique:=False
End Sub

Boisgontier
 

Pièces jointes

  • FiltreListe4-1.xlsm
    30.1 KB · Affichages: 15

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

  • Copie de FiltreListe4-1.xlsm
    30.2 KB · Affichages: 18
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

Chez moi sur un tableau de 25800 lignes (fichier joint), cette macro est 3 fois plus rapide que le filtre avancé :
VB:
Sub Filtre_job75()
Dim t, criteres, ub&, tablo, ncol%, n&, i&, j%, k&, col%
t = Timer
criteres = [liste].Resize(Application.CountA([liste]), 2) 'matrice, plus rapide, au moins 2 éléments
ub = UBound(criteres)
tablo = Sheets("BD").[A1].CurrentRegion
ncol = UBound(tablo, 2)
n = 1
For i = 2 To UBound(tablo)
    For j = 3 To ncol
        For k = 1 To ub
            If InStr(tablo(i, j), criteres(k, 1)) Then
                n = n + 1
                For col = 1 To ncol: tablo(n, col) = tablo(i, col): Next col 'copie la ligne
                GoTo 1
            End If
    Next k, j
1 Next i
'---restitution---
With Sheets("Résultat").[A1]
    .Resize(n, ncol) = tablo
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "job75"
End Sub
A+
 

Pièces jointes

  • Comparaison filtrages(1).xlsm
    900.2 KB · Affichages: 34

chris

XLDnaute Barbatruc
RE à tous

PowerQuery me donne un temps plus court mais il est possible que les duplications avantage...

Si je double la quantité de données en dupliquant, et relance le temps diminue comme s'il avait gardé des infos en cache...
 

Discussions similaires

F
Réponses
15
Affichages
775
F

Statistiques des forums

Discussions
292 748
Messages
1 925 838
Membres
182 848
dernier inscrit
Yannick60