Tableau à tris multiples par macro
Le
pat

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
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
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$
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
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 :
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 !!!!!!!
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