XL 2016 Filtre élaboré vba

tinet

XLDnaute Impliqué
Bonjour le forum,

Je suis obligé de faire un filtre dans un tableau avec nombreuses valeurs




Voici un exemple de mon critère de filtre que j'utilise

=OU(E2="bc100";E2="fr20";E2="zer254") en AA2



Pour m'éviter d'inscrire toutes les valeurs environ une soixantaine dans le code



Mon idée serait c'est possible d'avoir dans une feuille un tableau où j' indiquerai mes différents critères



Voilà ce que j'utilise après pour faire fonctionner mon filtre

Sub supligne()
With Feuil3
On Error Resume Next
.ShowAllData 'enléve filtre
derl = .Range("A65536").End(xlUp).Row
Sheets("base").Range("AA2").FormulaLocal = "=OU(E2 = ""bc100"";E2 = ""fr20""; E2 = ""zer254"")"
.Range("A1:I" & derl).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("base").Range("AA1").CurrentRegion, Unique:=False

End With
End Sub

merci pour votre aide
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

Comme ceci
VB:
Sub sup_Lignes()
Range("C1:C34").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Feuil2").Range("A1:A5"), Unique:=False
Set pf = [_FilterDataBase]
Application.DisplayAlerts = False
If WorksheetFunction.Subtotal(3, pf.Offset(1).Resize(pf.Rows.Count - 1, 1)) > 0 Then
    pf.Offset(1).Resize(pf.Rows.Count - 1).EntireRow.Delete
End If
ActiveSheet.ShowAllData
End Sub
Attention: en Feuil2 (en A1:A5)
code
lapin1
lapin2
lapin3
lapin4
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
RE

Relis mon message précédent attentivement
(notamment la fin de celui-ci)

NB: J'ai évidemment testé avant de poster et cela fonctionne parfaitement sur mon PC.
Et cela parce que je respecte tout ce que j'ai décris dans mon précédent message ;)
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

Ceci devrait faire l'affaire
1) Les critères sont agencés comme ci-dessous:
01critElab.jpg


2) et la macro modifiée comme suit:
VB:
Sub Suppr_Lignes_II()
Dim a As Worksheet, b As Worksheet
Set a = Sheets("Feuil1"): Set b = Sheets("Feuil2")
a.Range(a.Cells(1, "C"), a.Cells(Rows.Count, "C").End(xlUp)).AdvancedFilter _
    Action:=1, CriteriaRange:=b.Range("A1:D2"), Unique:=False
Set pf = [_FilterDataBase]
Application.DisplayAlerts = False
If WorksheetFunction.Subtotal(3, pf.Offset(1).Resize(pf.Rows.Count - 1, 1)) > 0 Then
    pf.Offset(1).Resize(pf.Rows.Count - 1).EntireRow.Delete
End If
a.ShowAllData
End Sub
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
550
Réponses
5
Affichages
449

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib