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
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
Merci pour votre retour j'essaie tout ça t je reviens vers vousBonsoir Phddesi,
C'est plus clair maintenant.
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
bonjourRe,
Un essai en PJ avec :
VB: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