Trie personnalisé d'une listbox

[Mikakawel]

Bonjour je bloque depuis deux jours et malgré mes recherches sur le net je ne réussis pas à trier une listbox suivant un ordre personnalisé. Le tris alphabétique croissant et décroissant c'est ok.

Je vous joint un fichier exemple, le but est de trier la listbox1 (celle de gauche) de l'userform qui s'affiche en cliquant sur le bouton de macro. J'ai crée les deux boutons des tris croissant et décroissants mais je souhaite classer les items de cette listbox suivant l'ordre indiqué dans la liste chrono présente sur cette même page.

(la listbox1 est remplie grâce à un double clic sur un item de la listbox2, elle même remplie en fonction du choix de la combobox1. au clic mise à jour, l'application fait un joint pour remplir la case commentaire de la ligne choisie, si on ouvre à nouveau l'uf elle opère un split de commentaires pour remplir la listbox1).

Merci d'avance à tous ceux qui pourront m'aider .

 

[sousou]

Bonjour
A tester, si c'est bien ce que tu veux,
J'ai du bidouiller (trim) pour supprimer les espaces que tu ajoutes dans la listbox1
A voir si c'est compatible au reste

 

[Mikakawel]

C'est génial merci beaucoup ! Je découvre de nouvelles fonctions ! Les espaces sont dues à une manipulation de caractères car j'ai une gestion des quantités en plus mais je n'ai pas voulu encombrer, j'adapterais ! Il me reste à comprendre tout le code, merci encore.

 

[sousou]

Le code:
1/Création d'une collection Chronos de l'ensemble des ligne chrono
2/Pour chaque élément de la collection (ordre) je regarde si il est dans la listbox1
3/si oui je le place à la fin de la listbox1 sinon je passe à l'élément suivant
Lorsque j'ai examiné tous les éléments je me retrouve avec une listbox1 qui comprend non seulement les éléments initiaux, mais à la suite les mêmes éléments classés (mettre un point d’arrêt pour voir)
4/ je supprime les premiers éléments de la list, il ne me reste que ceux classés

 

[Mikakawel]

C'est genial j'ai bien réussi à adapter le code ca fonctionne très bien même avec ma manipulation de caractères. J'ai essayé de l'adapter pour qu"il me change la couleur de police (en rouge) de la case commentaire si il trouve un élément d'une autre liste (aleas) il fonctionne bien, mais ne reussi pas à replacer la couleur initiale (noir) lorsque l'élément disparait de la listbox...une idée du pourquoi?
J'ai essayé avec application.match et application.countif mais toujours le même constat il reconnait le mot, mais ne fait rien lorsqu'il disparait.

 

[sousou]

fichier! SVP

 

[Mikakawel]

Résolu ! voici le code utilisé:

For i = 0 To ListBox1.ListCount - 1 'Pour chaque élement de la liste
' Réduction de l'item en supprimant les 4 derniers caractères
txt = Left(ListBox1.List(i), Len(ListBox1.List(i)) - 4)
If Application.CountIf(Worksheets("AP").Range("N2:N28"), txt) > 0 Then
ActiveSheet.Range("Y" & ActiveCell.Row).Font.Color = 255: Exit For
Else
If Application.CountIf(Worksheets("AP").Range("N2:N28"), txt) = 0 Then
ActiveSheet.Range("Y" & ActiveCell.Row).Font.Color = 1
End If
End If
Next