Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Tri listbox

A

alias_2003

XLDnaute Occasionnel
Bonsoir à tous,
Le code ci-dessous fonctionne parfaitement pour trier des listboxes, le seul soucis c'est qu'il impose que toutes les lignes de la colonne triée soient remplies... Ce qui n'est évidement pas le cas pour l'une des colonnes de ma listbox...
Est-il possible d'ajouter cette condition ?
Merci beaucoup,
Amicalement
Code: 
Sub SortListBox(oLb As MSForms.ListBox, sCol As Long, sType As Long, sDir As Long)
'Run "SortListBox", [ListBox Name], [ListBox column to sort by], [Alpha(1) or Numeric(2) or Date(3) Sort], _
    [Ascending(1) or Descending(2) Order]
    Dim vaItems As Variant
    Dim i As Long, j As Long, k As Long
    Dim c As Long
    Dim vTemp As Variant
    
     'Put the items in a variant array
    vaItems = oLb.List
    
    If sType = 1 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                 'Sort Ascending (1)
                If sDir = 1 Then
                    If vaItems(i, sCol) > vaItems(j, sCol) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                    
                ElseIf sDir = 2 Then
                    If vaItems(i, sCol) < vaItems(j, sCol) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If
                
            Next j
        Next i
    ElseIf sType = 2 Then
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                 'Sort Ascending (1)
                If sDir = 1 Then
                    If CLng(vaItems(i, sCol)) > CLng(vaItems(j, sCol)) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                 ElseIf sDir = 2 Then
                    If CLng(vaItems(i, sCol)) < CLng(vaItems(j, sCol)) Then
                        For c = 0 To oLb.ColumnCount - 1
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If
                
            Next j
        Next i
 
    ElseIf sType = 3 Then
    For k = LBound(vaItems, 1) To UBound(vaItems, 1)
        If IsNull(vaItems(k, sCol)) Or vaItems(k, sCol) = "" Or IsDate(vaItems(k, sCol)) = False _
            Then vaItems(k, sCol) = 0
    Next k
        For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
            For j = i + 1 To UBound(vaItems, 1)
                 'Sort Ascending (1)
                If sDir = 1 Then
                    If CLng(CDate(vaItems(i, sCol))) > CLng(CDate(vaItems(j, sCol))) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                    
                     'Sort Descending (2)
                ElseIf sDir = 2 Then
                    If CLng(CDate(vaItems(i, sCol))) < CLng(CDate(vaItems(j, sCol))) Then
                        For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
                            vTemp = vaItems(i, c)
                            vaItems(i, c) = vaItems(j, c)
                            vaItems(j, c) = vTemp
                        Next c
                    End If
                End If
                
            Next j
        Next i
    End If
   
    For k = LBound(vaItems, 1) To UBound(vaItems, 1)
        If vaItems(k, sCol) = 0 Then vaItems(k, sCol) = ""
    Next k
    oLb.List = vaItems
End Sub
 
Trier par date Trier par votes

Dranreb

XLDnaute Barbatruc
Bonsoir.
Je vous conseillerais, après initialisation de valitems, de la parcourir un coup pour convertir les valeurs en le type souhaité de manière à ne plus avoir qu'une procédure de classement derrière, ne refaisant plus de conversion.
Mon module de classe TableIndex appliquerait une technique plus rapide.
Personnellement je ne repars jamais des ListBox ni des ComboBox: ce sont leurs tableaux sources que j'indexe avec cet outil, comme ça je n'ai pas de conversion à faire.
 
Vote positif 0 Vote négatif
A

alias_2003

XLDnaute Occasionnel
Bonsoir Dranreb, Lone-Wolf, le Forum,
Merci à tous les 2 pour vos réponses !
@Dranreb : votre module de classe me semble très intéressant ! est-ce que je pourrais le tester ?
@Lone-wolf : c'est une idée à laquelle je n'avais pas pensé ! Je vais voir comment je peux faire!

Merci beaucoup à vous
Amicalement
 
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
alias_2003 à dit:
votre module de classe me semble très intéressant ! est-ce que je pourrais le tester ?
Cliquez pour agrandir...
Certainement. Vous trouverez dans les discussions auxquelles je réponds de nombreux classeurs de mon cru nommés CBxLiéesPseudo.xlsm ou GrpOrgPseudo.xlsm qui le contiennent.
Aussi des SujetCBxPseudo.xlsm, qui n'utilisent qu'une partie de ce vaste ensemble de procédures de service qui s'articulent toutes autour de ce module de classe.
Et même quelques TIdxPseudo.xlsm qui n'utilisent que lui.
 
Dernière édition:
Vote positif 0 Vote négatif
A

alias_2003

XLDnaute Occasionnel
Bonjour Dranreb, Lone-Wolf, le Forum,
Merci ! J'ai trouvé très facilement !
Par contre, je vous avoue de ne pas savoir comment utilisé ce module de classe avec les listboxes...
Pourriez-vous m'aider à l'adapter à ce fichier modèle ?
Merci beaucoup,
Bonne journée


EDIT 07:40 : mise à jour du fichier
 
Dernière édition:
Vote positif 0 Vote négatif
A

alias_2003

XLDnaute Occasionnel
Bonjour Lone-wolf,
J'ai tellement honte que je pense supprimer mon profil sur ce forum ...
J'ai mis le fichier test à jour, il contient maintenant le module de classe TableIndex de Dranreb !
Mille excuses,
Amicalement
 
Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc
Re,

Alias, faut pas confondre LISTVIEW avec LISTBOX, ce sont deux contrôles différents. En PJ, un classeur exemple de notre ami Jacques Boisgontier, peut-être pourra-t-il t'interésser.
 

Pièces jointes

  • FormTriListBox11.xlsm
    121.6 KB · Affichages: 54
Vote positif 0 Vote négatif
A

alias_2003

XLDnaute Occasionnel
Re,
En effet... Je suis désolé. C'est bien une listbox qui j'ai dans mon fichier réel...
J'ai ajouté le module de classe au fichier test de M. Boisgontier.
Merci pour ta vigilance
 

Pièces jointes

  • FormTriListBox11.xlsm
    132.3 KB · Affichages: 38
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
Bonjour.
Voici le genre de code qui peut être écrit pour utiliser TableIndex :
VB: 
Private TDon()

Private Sub UserForm_Initialize()
With Sheets("TriListBox")
   TDon = .Range("A2:C" & .[A65000].End(xlUp).Row).Value
   End With
Me.ListBox1.List = TDon
End Sub

Private Sub LTriNom_Click()
TriPourLBx 1
Me.LTriNom.ForeColor = vbRed
Me.LTriVille.ForeColor = vbBlack
Me.LCP.ForeColor = vbBlack
End Sub
Private Sub LTriVille_Click()
TriPourLBx 2
Me.LTriNom.ForeColor = vbBlack
Me.LTriVille.ForeColor = vbRed
Me.LCP.ForeColor = vbBlack
End Sub
Private Sub LCP_Click()
TriPourLBx 3
Me.LTriNom.ForeColor = vbBlack
Me.LTriVille.ForeColor = vbBlack
Me.LCP.ForeColor = vbRed
End Sub

Private Sub TriPourLBx(ByVal Col As Long)
Dim TLBx()
TriIdx TDon, TLBx, Col
Me.ListBox1.List = TLBx
End Sub

Private Sub TriIdx(TE(), TS(), ByVal Col As Long)
Dim LE As Long, LS As Long, C As Long
ReDim TS(LBound(TE, 1) To UBound(TE, 1), LBound(TE, 2) To UBound(TE, 2))
With New TableIndex
   .Init LBound(TE, 1), UBound(TE, 1)
   While .Actif: .BInfA = TE(.B, Col) < TE(.A, Col): Wend
   LS = LBound(TS, 1) - 1: .Parcourir
   While .Actif: LS = LS + 1: LE = .Suivant
      For C = LBound(TE, 2) To UBound(TE, 2): TS(LS, C) = TE(LE, C): Next C: Wend: End With
End Sub
 
Vote positif 0 Vote négatif
A

alias_2003

XLDnaute Occasionnel
Bonsoir Dranreb, Lone-wolf, le Forum,
Merci à vous 2 pour vos réponses !! Je vais prendre le temps de les décortiquer et je reviendrai vers vous !
Merci beaucoup,
Bonne soirée
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
297
sylvanu
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
217
Compte Supprimé 979
C
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
158
GClaire
G
C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
244
Claudinedu13
C
  • Question
Microsoft 365 Format Nombre Combobox dans Feuille
Réponses
3
Affichages
167
fanch55
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
403
Messan
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
187
Le Rouky
L
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
320
TooFatBoy
  • Résolu(e)
Microsoft 365 [VBA] Barre de recherche dynamique - objectif : cacher les lignes hors résultat
Réponses
3
Affichages
201
Sergent_Lipton
  • Résolu(e)
XL 2016 Macro Dim c As Range, i As Long
Réponses
8
Affichages
227
mapomme
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…