merci pour la correction,
je ne vois aucun inconvénient à ce que tu conserves ce fichier comme exemple.
Etant perfectionniste et obstiné (ben oui, on a tous des défauts
), j'ai ajouté quelques modifications :- Rajout du "tri de la base de données" par titre de films quand on lance la Macro "Initialise".
Car sinon les nouvelles entrées dans la base se trouve à la fin, ça faisait un peu "désordre".
- La cellule sélectionnée remonte comme critère de tri pour toute la base : que ce soit un Titre, Genre, Pays, Année, Acteurs, Réalisateur, Durée.
- Insertion d'une ligne (vide) entre "les critères pour filtrage" et "la base" (Ligne 9)
But : ne pas exécuter la macro "Remonter dans critère" quand on tape "Entrer" après avoir rentré un critère de filtre en ligne 8, car du coup on sélectionnait la 1° entrée de la base, et ça remplaçait le filtre qui vient d'être rentré.
Donc ça, c'était pour mon coté "perfectionniste", voici mon coté "obstiné" :
J'aimerai utiliser une liste déroulante de tous les acteurs en case F8, comme c'était le cas dans mon fichier initial.
j'ai donc ce code en main :
- Code: Tout sélectionner
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cel As Range
Dim MesActeurs As Object
Dim Tmp
Dim I As Integer
If Target.Address <> "$A$2" Or Target.Count > 1 Then Exit Sub ' si la cellule sélectionnée n'est pas A2
' ou que tu as sélectionné plusieurs cellules
' on quitte
Range("B8:H8").Select ' Sélectionnez la plage de critères de filtrage
Selection.ClearContents ' et effacer tous les critères
Set MesActeurs = CreateObject("Scripting.Dictionary") ' création d'un objet "Dictionnary" qui nous permettra
' d'y intégrer tous les noms d'acteurs sans doublons
For Each Cel In Range("F11:E" & [F65000].End(xlUp).Row) ' pour chaque cellule de E11 à Bxx (dernière ligne remplie)
Tmp = Split(Cel.Value, ",") ' dans le tableau à une dimension, on "splitte" la valeur
' de la cellule, chaque nom séparé par une virgule se trouvant
' dans le tableau (tmp(o), pour le 1er nom, tmp(1) pour le 2ème...
For I = LBound(Tmp) To UBound(Tmp) ' de la 1ère valeur du tableau tmp à la dernière
If Not MesActeurs.Exists(Trim(Tmp(I))) Then MesActeurs.Add Trim(Tmp(I)), Trim(Tmp(I))
' c'est ici qu'on utilise l'object dictionnary
' si le nom n'y existe pas, on le rajoute dans l'objet
' Trim permettant de supprimer les espaces en début
' et fin du nom
Next I ' au suivant
Next Cel ' cellule suivante
Tmp = MesActeurs.Items ' on rentre toutes les valeurs de l'objet dictionnary dans
' un tableau à une dimension
Call tri(Tmp, LBound(Tmp), UBound(Tmp)) ' on effectue le tri de ce tableau (voir dans Module1)
Columns(9).ClearContents ' on vide la liste des acteurs qu'il y avait dans la colonne I
Application.EnableEvents = False ' on interdit tout déclenchement d'évènement afin d'éviter des boucles
For I = LBound(Tmp) To UBound(Tmp) ' de la première valeur du tableau à la dernière
Cells(I + 1, 9) = Tmp(I) ' on remplit la colonne I des noms des acteurs, qui sont dans le tableau Tmp
Next I
Range("$F$8").Select
With Selection.Validation ' avec la validation des données de la cellule F8
.Delete ' on supprime l'ancienne "Données/Validation"
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$I$1:$I$" & [I65000].End(xlUp).Row ' on en créé une nouvelle, avec les noms de la colonne F
End With
Application.EnableEvents = True ' on ré-autorise les déclenchements d'évènements
End Sub
- Code: Tout sélectionner
Sub tri(a, gauc, droi) ' Quick sort
'code de tri de JBoisgontier (http://boisgontierj.free.fr/)
'code hyper rapide
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
Temp = a(g): a(g) = a(d): a(d) = Temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Mais je n'arrive pas à le mettre en place, car mes compétences sont trop limités.
Le simple fait de devoir renommer "Private Sub Worksheet_SelectionChange" car il existe déja est bloquant pour moi, car si je change de nom, la Private sub ne s'execute même plus...
Pourrais-tu m'aider ?
PS : dans le code que j'ai mis ici, la liste des acteurs est (censé) être créé en colonne I, mais il parait bien plus propre qu'elle le soit dans le 2° onglet ou sont déja les autres listes.
