XL 2010 Tri Multi-Criteres par VBA suivant valeurs des cellules

LEIYAZ

LEIYAZ

XLDnaute Nouveau
Bonjour,

J'ai un fichier de suivi de commandes sur lequel j'ai créer des cellules pour me permettre de trier par VBA la valeur de la cellule désignée.

Voici un exemple de code :

VB: 
Sub trier_UG()

Sheets("BDD_Commandes_Devis").Unprotect Password:="0000"
Range("BD_Commandes[#Headers]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("BD_Commandes").Range.AutoFilter Field:=10, _
Criteria1:=Range("d7").Value
ActiveWindow.SmallScroll Down:=-100
Range("d7").Select
Selection.ClearContents
Range("d7").Select
Sheets("BDD_Commandes_Devis").Protect Password:="0000", AllowSorting:=True, AllowFiltering:=True

End Sub

Le problème c'est que cela ne s'applique qu'a une seule colonne. J'aimerais pouvoir renseigner plusieurs critères dans plusieurs cellules et lancer une recherche VBA avec les lignes qui présentent les mêmes critères.

J'ai essayé de rentrer plusieurs critères :

VB: 
Sub tri_MultiCriteres()

Sheets("BDD_Commandes_Devis").Unprotect Password:="0000"
Range("BD_Commandes[#Headers]").Select
Selection.AutoFilter


ActiveSheet.ListObjects("BD_Commandes").Range.AutoFilter Field:=5, _
Criteria1:=Range("d5").Value

ActiveSheet.ListObjects("BD_Commandes").Range.AutoFilter Field:=10, _
Criteria1:=Range("d7").Value


ActiveSheet.ListObjects("BD_Commandes").Range.AutoFilter Field:=2, _
Criteria1:=Range("d9").Value

ActiveSheet.ListObjects("BD_Commandes").Range.AutoFilter Field:=7, _
Criteria1:=Range("d11").Value


ActiveSheet.ListObjects("BD_Commandes").Range.AutoFilter Field:=14, _
Criteria1:=Range("d13").Value

ActiveSheet.ListObjects("BD_Commandes").Range.AutoFilter Field:=13, _
Criteria1:=Range("d15").Value



ActiveWindow.SmallScroll Down:=-100
Range("d15").Select
Selection.ClearContents
Range("d7").Select
Selection.ClearContents
Range("d5").Select
Sheets("BDD_Commandes_Devis").Protect Password:="0000", AllowSorting:=True, AllowFiltering:=True
End Sub

Mais cela crée des erreurs de résultats..

Pouvez vous m'aider ? Je vous mets en pièce jointe mon fichier.

Merci par avance :)
 

Pièces jointes

  • Suivi_Commandes_2021.xlsb
    956.7 KB · Affichages: 20
Solution
Phil69970
Bonjour LEIYAZ, le forum

1) Ce code remplace tous les autres codes des filtres.
2) Il filtre en fonction de la valeur remplie en D5, D7, D9, D11, D13 ou D15.
3) Il ne filtre QUE sur 1 seul critère, la 1ere valeur qu'il trouve de remplit (voir point 2)
4) A la fin de l'exécution du filtre tu as un retour avec un message sur les résultats qu'il a trouvé ou pas.
5) Je te laisse modifier les affectations du/des boutons pour les relier à cette procédure selon si tu veux garder 1 ou 6 boutons(c'est la même procédure qui marche pour tous les boutons, pas la peine de la copier 6 fois bien sur)

VB: 
Sub Filtre()

Dim RechCritere  As Variant
Dim CelVal  As Range
Dim Fld As Integer
Dim Colonne As String...
Trier par date Trier par votes
Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour LEIYAZ, le forum

J'ai l'impression que tu confonds TRI et FILTRE.
Ton titre : Tri Multi-Criteres parle de tri
Et ton code fait des filtres.

Donc que veux tu faire ?

Ton code filtre fonctionne bien mais ne tri rien du tout.

J'ai un peu optimisé ton code qui FILTRE (le tien marche très bien).
VB: 
[S]'Sub Tri_Multiple()[/S] 'Se n'est pas un TRI mais un FILTRE
Sub Filtre_Multiple()

Sheets("BDD_Commandes_Devis").Unprotect Password:="0000"
Range("BD_Commandes[#Headers]").AutoFilter

With ActiveSheet.ListObjects("BD_Commandes").Range
    .AutoFilter
    .AutoFilter Field:=5, Criteria1:=Range("D5").Value
    .AutoFilter Field:=10, Criteria1:=Range("D7").Value
    .AutoFilter Field:=2, Criteria1:=Range("D9").Value
    .AutoFilter Field:=7, Criteria1:=Range("D11").Value
    .AutoFilter Field:=14, Criteria1:=Range("D13").Value
    .AutoFilter Field:=13, Criteria1:=Range("D15").Value
End With

[D5].MergeArea.ClearContents
[D7].ClearContents
[D15].MergeArea.ClearContents

Sheets("BDD_Commandes_Devis").Protect Password:="0000", AllowSorting:=True, AllowFiltering:=True

End Sub

[S]'Sub trier_UG()[/S] 'Se n'est pas un TRI mais un FILTRE
Sub Filtre_UG()

Sheets("BDD_Commandes_Devis").Unprotect Password:="0000"
Range("BD_Commandes[#Headers]").AutoFilter

With ActiveSheet.ListObjects("BD_Commandes").Range
    .AutoFilter Field:=10, Criteria1:=Range("D7").Value
End With

[D7].ClearContents
Sheets("BDD_Commandes_Devis").Protect Password:="0000", AllowSorting:=True, AllowFiltering:=True
End Sub
@Phil69970
 
Dernière édition:
Vote positif 0 Vote négatif
LEIYAZ

LEIYAZ

XLDnaute Nouveau
Bonjour @Phil69970 , je vous remercie pour le code (je n'imaginais pas une réponse si tôt dans la journée ! ^^').

Je confond effectivement les tri et les filtres, je souhaite donc effectivement filtrer les données et non les trier.

Concernant le code, celui que vous m'avez donné fonctionne très bien, merci pour l'optimisation mais ce que je souhaites faire, c'est par exemple en activant cette macro rechercher une commande qui contient un ou plusieurs des critères de recherche spécifié dans les cellules concernées avec si possible une text box indiquant qu'aucun résultat n'a été trouvé.

Par exemple :

EXEMPLE.PNG


Or avec cette macro, il exécute la recherche de gauche a droite et si il ne trouve pas le résultat dans les premières colonnes, il ne trouve aucune correspondance sur les autres colonnes.

Merci de votre aide toujours précieuse :)
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour LEIYAZ, le forum

1)Vu le nombre de critère de filtre important (ici tu en as 6) je pense que tu n'auras pratiquement jamais de résultat.

2)Pourquoi tu effaces seulement le résultat de 3 critères de filtres et pas des 3 autres ?

3)J'ai rajouté un message si la recherche ne trouve rien donc pratiquement tout le temps voir point 1

4)Pourquoi ne pas laisser seulement les filtres "individuels" et vouloir un multi filtre qui ne renverra presque jamais rien ?

VB: 
Sub Filtre_Multiple()

Sheets("BDD_Commandes_Devis").Unprotect Password:="0000"
Range("BD_Commandes[#Headers]").AutoFilter

With ActiveSheet.ListObjects("BD_Commandes").Range
    .AutoFilter
    .AutoFilter Field:=5, Criteria1:=Range("D5").Value
    .AutoFilter Field:=10, Criteria1:=Range("D7").Value
    .AutoFilter Field:=2, Criteria1:=Range("D9").Value
    .AutoFilter Field:=7, Criteria1:=Range("D11").Value
    .AutoFilter Field:=14, Criteria1:=Range("D13").Value
    .AutoFilter Field:=13, Criteria1:=Range("D15").Value
End With

Dim VarFiltre As Integer
VarFiltre = Evaluate("SUBTOTAL(3,B21:B10000)")
If VarFiltre = 0 Then MsgBox "La recherche n'a pas aboutie, vous n'avez aucun résultat", vbCritical, "Résultat de la recherche"

[D5].MergeArea.ClearContents
[D7].ClearContents
[D15].MergeArea.ClearContents

Sheets("BDD_Commandes_Devis").Protect Password:="0000", AllowSorting:=True, AllowFiltering:=True

End Sub
@Phil69970
 
Vote positif 0 Vote négatif
LEIYAZ

LEIYAZ

XLDnaute Nouveau
Bonjour @Phil69970,

J'ai effectivement modifié mon code pour effacer les 3 autres critères de filtres.

Merci pour le MsgBox, je n'avais pas pensé a faire comme cela :)

Je vais laisser les filtres individuels, j'ai voulu essayer comme cela pour diminuer le nombre de résultats qui apparaissent.

Est-il possible de dire a excel en cliquant sur "rechercher" si il ne trouve pas de resultat sur la premiere colonne, de passer à la deuxieme etc jsuqu'a trouver le critère demandé ? Cela ne me laisserait qu'un seul bouton avec une macro unique au lieu de 6 boutons et 6 macros.

Par exemple j'ai pensé de dire à excel de ne trier que les cellules de critères remplies et de ne pas prendre en compte celles qui sont vides ?

Merci encore :)
 
Dernière édition:
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour LEIYAZ, le forum

1) Ce code remplace tous les autres codes des filtres.
2) Il filtre en fonction de la valeur remplie en D5, D7, D9, D11, D13 ou D15.
3) Il ne filtre QUE sur 1 seul critère, la 1ere valeur qu'il trouve de remplit (voir point 2)
4) A la fin de l'exécution du filtre tu as un retour avec un message sur les résultats qu'il a trouvé ou pas.
5) Je te laisse modifier les affectations du/des boutons pour les relier à cette procédure selon si tu veux garder 1 ou 6 boutons(c'est la même procédure qui marche pour tous les boutons, pas la peine de la copier 6 fois bien sur)

VB: 
Sub Filtre()

Dim RechCritere  As Variant
Dim CelVal  As Range
Dim Fld As Integer
Dim Colonne As String, Ligne As Long, Cel As String

With Sheets("BDD_Commandes_Devis")
    .Unprotect Password:="0000"
    Range("BD_Commandes[#Headers]").AutoFilter
    For Each CelVal In .Range("D5,D7,D9,D11,D13,D15")
        RechCritere = CelVal.Value
        If RechCritere > 0 Then
            Colonne = Left$(CelVal.Address(0, 0), (CelVal.Column < 27) + 2)
            Ligne = CelVal.Row
            Cel = Colonne & Ligne
            Range("BD_Commandes[#Headers]").AutoFilter
            With ActiveSheet.ListObjects("BD_Commandes").Range
                Select Case Cel
                Case "D5"
                    Fld = 5
                Case "D7"
                    Fld = 10
                Case "D9"
                    Fld = 2
                Case "D11"
                    Fld = 7
                Case "D13"
                    Fld = 3
                Case "D15"
                    Fld = 13
                End Select
                .AutoFilter Field:=Fld, Criteria1:=RechCritere
                Range(Cel).MergeArea.ClearContents
            End With
            'Exit Sub
        End If
    Next CelVal

    Dim VarFiltre As Integer
    Dim Derlig As Long
    Derlig = Worksheets("BDD_Commandes_Devis").Range("C" & Rows.Count).End(xlUp).Row - 20
    VarFiltre = Evaluate("SUBTOTAL(3,B21:B10000)")
    If VarFiltre = 0 Or VarFiltre = Derlig Then
        MsgBox "La recherche par filtre n'a pas aboutie, vous n'avez aucun résultat", vbCritical, "Résultat de la recherche"
        .Protect Password:="0000", AllowSorting:=True, AllowFiltering:=True
        Exit Sub
    End If
   
    .Protect Password:="0000", AllowSorting:=True, AllowFiltering:=True
   
    'Le message ci dessous peut etre supprimer si genant
    If VarFiltre = 1 Then
        MsgBox "Votre filtre a trouvé " & VarFiltre & " resultat", vbCritical, "Résultat de la recherche"
    Else
        MsgBox "Votre filtre a trouvé " & VarFiltre & " resultats", vbCritical, "Résultat de la recherche"
    End If
End With
End Sub

@Phil69970
 
Dernière édition:
Vote positif 0 Vote négatif
Solution

Discussions similaires

G
  • Résolu(e)
XL 2016 VBA : Copie d'une ligne après application d'un filtre
Réponses
7
Affichages
767
gfgghbhg
G
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
D
  • Question
Microsoft 365 VBA Problème dans un évènement Before Save
Réponses
5
Affichages
656
danielco
D
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
lestoiles1
  • Question
XL 2013 Fonction vba copie coller
Réponses
1
Affichages
837
job75
job75
LEIYAZ
  • Résolu(e)
XL 2019 Macro trier sur titre colonne et non sur le numéro
Réponses
2
Affichages
873
LEIYAZ
LEIYAZ
J
  • Résolu(e)
Microsoft 365 Protection d'une feuille en VBA
Réponses
2
Affichages
1 K
Jacko17
J
S
  • Résolu(e)
Autres Pourquoi les coches dans le filtre ne s'affiche pas malgré code VBA semble marcher (uniquement filtre personnalisé dans table base de données)
Réponses
6
Affichages
914
Scoub
S
S
  • Question
Autres Comment traiter filtre imbriqué en formule VBA ? (filtres sur plusieurs colonnes) sur TCD (avec segment) et sur simple base de données
Réponses
2
Affichages
1 K
merinos
merinos
G
  • Question
XL 2010 Extraction de données suivant onglets (msgbox)
Réponses
2
Affichages
911
GV91
G

Membres actuellement en ligne

1 membres et 20 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 100
Membres
103 116
dernier inscrit
kutobi87