XL 2010 Tri listbox

[alias_2003]

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

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

 

[Dranreb]

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.

 

[Lone-wolf]

Bonsoir Dranreb, alias

Le plus simple ce n'est pas de faire le tri sur la(es) colonne(s) de la feuille directement? À moins de dire une grosse bêtise.

 

[alias_2003]

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

 

[Dranreb]

votre module de classe me semble très intéressant ! est-ce que je pourrais le tester ?

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.

 

[alias_2003]

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

 

[Lone-wolf]

Bonjour alias

Si tu veux que Dranreb fasse le nécessaire, faudrait ajouter le module dont tu parle; parce-que là j'en vois aucun.

 

[alias_2003]

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

 

[Lone-wolf]

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.

 

[alias_2003]

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

 

[Lone-wolf]

Re

Si tu utilise le modèle de Jacques, le module de classe n'est pas nécessaire. D'ailleurs tu l'as testé??? Et il faut mettre ton fichier pas celui de Jacques.

 

[alias_2003]

Re,
Non, j'avoue ne pas avoir regardé...
Je regarde tout ça en rentrant du travail...

 

[Dranreb]

Bonjour.
Voici le genre de code qui peut être écrit pour utiliser TableIndex :

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

 

[alias_2003]

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