Tableau à tris multiples par macro

Bonjour
Et un simple filtre sur les col A, C, D et E ne suffirait pas ?
Auquel cas, il suffirait de mettre en marche l'enregistreur de macro, puis
d'installer ce filtre tout simplement.....

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"pat" a écrit dans le message de groupe de discussion :
jbj8l0$thk$1@news.ett.com.ua...

Bonsoir à tous,
j'ai créé un tableau que je tri à partir de la cellule A2 avec une liste
déroulante (ceci dit en passant, pour ne pas me venter : le code m'a été
donné dans ce groupe il y a quelques mois).
J'ai donc une procédure dans la feuille et une en module.
J'aurais voulu trier sur d'autres critères selon les listes des cellules
C2, D2, E2.
Qui pourrais me mettre sur une piste pour C2 et je pourrais peut-être
enchainer seul sur les 2 dernières listes de tri.
Merci pour votre aide.
Voici le fichier http://cjoint.com/?0LfvmTPXDON

Houla pas du tout regardes les listes des colonnes A C D E et tu verras
que les listes pointent sur des lignes.
En fait c'est la disposition de mes "boutons" de listes qui est
trompeuse cela n'a rien a voir avec ces colonnes la.



Le 05/12/2011 21:58, Jacquouille a écrit :

Bonjour
Et un simple filtre sur les col A, C, D et E ne suffirait pas ?
Auquel cas, il suffirait de mettre en marche l'enregistreur de macro,
puis d'installer ce filtre tout simplement.....

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"pat" a écrit dans le message de groupe de discussion :
jbj8l0$thk$1@news.ett.com.ua...

Bonsoir à tous,
j'ai créé un tableau que je tri à partir de la cellule A2 avec une liste
déroulante (ceci dit en passant, pour ne pas me venter : le code m'a été
donné dans ce groupe il y a quelques mois).
J'ai donc une procédure dans la feuille et une en module.
J'aurais voulu trier sur d'autres critères selon les listes des cellules
C2, D2, E2.
Qui pourrais me mettre sur une piste pour C2 et je pourrais peut-être
enchainer seul sur les 2 dernières listes de tri.
Merci pour votre aide.
Voici le fichier http://cjoint.com/?0LfvmTPXDON

Salut � toi

Je modifierai ton code ainsi pour la liste d�roulante en C2 :

la ligne de code :

If Target.Address <> "$A$2" Then Stop 'Exit Sub

ainsi :

If Target.Address = "$A$2" Then

au dessus de la ligne :

GoTo Fin

je mettrais :

End If

je rajouterais ensuite de ce End If ces lignes :

If Target.Address = "$C$2" Then

On Error GoTo Erreur1

Application.Calculation = xlManual
Application.ScreenUpdating = False

Tout_afficher

If Target <> "Tout afficher" Then
For i1 = Cells(3, 2) + 2 To 3 Step -1
If Cells(4, i1) <> Target Then Columns(i1).Hidden = True
Next i1
End If

End If

ce qui donne le code global :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i1 As Integer

If Target.Address = "$A$2" Then

On Error GoTo Erreur1

Application.Calculation = xlManual
Application.ScreenUpdating = False

Tout_afficher

If Target <> "Tout afficher" Then
For i1 = Cells(3, 2) + 2 To 3 Step -1
If Cells(9, i1) <> Target Then Columns(i1).Hidden = True
Next i1
End If

End If

If Target.Address = "$C$2" Then

On Error GoTo Erreur1

Application.Calculation = xlManual
Application.ScreenUpdating = False

Tout_afficher

If Target <> "Tout afficher" Then
For i1 = Cells(3, 2) + 2 To 3 Step -1
If Cells(4, i1) <> Target Then Columns(i1).Hidden = True
Next i1
End If

End If

GoTo Fin

Erreur1:
MsgBox ("Une erreur inattendue est survenue.")

Fin:
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

End Sub


pour les autres listes d�roulantes il faut rajouter avant le GoTo F in
ces lignes � adapter � chaque liste :

If Target.Address = "$C$2" Then

On Error GoTo Erreur1

Application.Calculation = xlManual
Application.ScreenUpdating = False

Tout_afficher

If Target <> "Tout afficher" Then
For i1 = Cells(3, 2) + 2 To 3 Step -1
If Cells(4, i1) <> Target Then Columns(i1).Hidden = True
Next i1
End If

End If


en modifiant :

If Target.Address = "$C$2" Then (mettre l'adresse de la cellule
d�roulante)


et

If Cells(4, i1) <> Target Then Columns(i1).Hidden = True (adapter
Cells(4, i1) de la ligne qui porte les donn�es origines des filtres �
r�aliser ici ligne 4 pour la liste d�roulante en C2)


Fais des essais et dis moi !!!!!!!

Ok c'est ça. Merci de m'avoir mis sur la bonne voie. voici ce que j'ai
fait un peu plus court car j'étais inspiré :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i1 As Integer
critere = 0

If Target.Address = "$A$2" Then critere = 9
If Target.Address = "$C$2" Then critere = 4
If Target.Address = "$D$2" Then critere = 6
If Target.Address = "$E$2" Then critere = 5
If critere = 0 Then Exit Sub

On Error GoTo Erreur1

Application.Calculation = xlManual
Application.ScreenUpdating = False

Tout_afficher

If Target <> "Tout afficher" Then
For i1 = Cells(3, 2) + 2 To 3 Step -1
If Cells(critere, i1) <> Target Then Columns(i1).Hidden = True
Next i1
End If

GoTo Fin

Erreur1:
MsgBox ("Une erreur inattendue est survenue.")

Fin:
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

End Sub
Sub Tout_afficher()
Dim i2 As Integer

For i2 = Cells(3, 2) + 2 To 3 Step -1
Columns(i2).Hidden = False
Next i2

End Sub