Bonjour Phddesi,
Pensez vous que vous puissiez obtenir une réponse pertinente avec une demande aussi vague ?
Essayez de fournir un petit fichier test représentatif, ce sera beaucoup plus efficace.
Sub Cherche()
Range("A2:C" & Application.Max(2, [B65000].End(xlUp).Row)).ClearContents
Application.ScreenUpdating = False
Dim Tfiltre, BDD, Ligne%, i%, j%, k%
Tfiltre = Range("G2:G" & [G65000].End(xlUp).Row)
BDD = Sheets("Entrepot").Range("A2:C" & Sheets("Entrepot").[A65000].End(xlUp).Row)
Ligne = 2
For i = 1 To UBound(BDD)
For j = 1 To UBound(Tfiltre)
If BDD(i, 3) Like "*" & Tfiltre(j, 1) & "*" Then
For k = 1 To 3
Cells(Ligne, k) = BDD(i, k)
Next k
Ligne = Ligne + 1
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Vous ne pouvez pas avoir le beurre et l'argent du beurre.
Soit les filtres sont dans le code et donc en "dur" et c'est immuable, soit les filtres sont programmables sur la feuille et vous pouvez tout avoir.
Ou vous créez un second bouton "Tout voir" pour remplir la fonction. Voir PJ.
A mon avis la première version est la plus "universelle", vous mettez les filtres que vous voulez, si vous voulez tout voir vous effacez les filtres.
Bonjour
Voila je vous ai fait un petit fichier avec les explications à l'intérieur de ce que je veux avec un filtre avec 3 critères.
sur le fichier TEST 1 a déjà une macro.
Vous avez surement remarqué que dans les filtres, en VBA, on ne peut mettre que 2 critères.
Donc en PJ une tricherie :
On remplace les noms désiré par £Nom, on filtre sur 1 critère "£*" puis on supprime les £. Pas très orthodoxe mais efficace :
VB:
Sub Filtre_Hors_Samsung_BB()
Ajout£
Sheets("entrepot").Select
Range("Base[#All]").Select
ActiveSheet.ListObjects("Base").Range.AutoFilter Field:=3, _
Criteria1:="<>*£*"
Suppression£
[A1].Select
End Sub
Sub Ajout£()
N = [Base].Rows.Count
For i = 1 To [Base].Rows.Count
Tele = Left([Base[modele tele]].Item(i), 6)
If Tele = "Samsun" Or Tele = "huawei" Or Tele = "BB" Then [Base[modele tele]].Item(i) = "£" & [Base[modele tele]].Item(i)
Next i
End Sub
Sub Suppression£()
N = [Base].Rows.Count
For i = 1 To [Base].Rows.Count
If Left([Base[modele tele]].Item(i), 1) = "£" Then [Base[modele tele]].Item(i) = Mid([Base[modele tele]].Item(i), 2)
Next i
End Sub
Vous avez surement remarqué que dans les filtres, en VBA, on ne peut mettre que 2 critères.
Donc en PJ une tricherie :
On remplace les noms désiré par £Nom, on filtre sur 1 critère "£*" puis on supprime les £. Pas très orthodoxe mais efficace :
VB:
Sub Filtre_Hors_Samsung_BB()
Ajout£
Sheets("entrepot").Select
Range("Base[#All]").Select
ActiveSheet.ListObjects("Base").Range.AutoFilter Field:=3, _
Criteria1:="<>*£*"
Suppression£
[A1].Select
End Sub
Sub Ajout£()
N = [Base].Rows.Count
For i = 1 To [Base].Rows.Count
Tele = Left([Base[modele tele]].Item(i), 6)
If Tele = "Samsun" Or Tele = "huawei" Or Tele = "BB" Then [Base[modele tele]].Item(i) = "£" & [Base[modele tele]].Item(i)
Next i
End Sub
Sub Suppression£()
N = [Base].Rows.Count
For i = 1 To [Base].Rows.Count
If Left([Base[modele tele]].Item(i), 1) = "£" Then [Base[modele tele]].Item(i) = Mid([Base[modele tele]].Item(i), 2)
Next i
End Sub
Sub Cherche()
Range("A2:C" & Application.Max(2, [B65000].End(xlUp).Row)).ClearContents
Application.ScreenUpdating = False
Dim Tfiltre, BDD, Ligne%, i%, j%, k%
Tfiltre = Range("G2:G" & [G65000].End(xlUp).Row)
BDD = Sheets("Entrepot").Range("A2:C" & Sheets("Entrepot").[A65000].End(xlUp).Row)
Ligne = 2
For i = 1 To UBound(BDD)
For j = 1 To UBound(Tfiltre)
If BDD(i, 3) Like "*" & Tfiltre(j, 1) & "*" Then
For k = 1 To 3
Cells(Ligne, k) = BDD(i, k)
Next k
Ligne = Ligne + 1
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub