Discussion :

[IronHeavy]

Bonjour A tous,

Je dispose d'une listbox fonctionnelle à 1 colonne qui:

- recherche le contenu de la colonne F des pages définies dans mon fichier
- trie les items et supprime les doublons

Je souhaiterai élargir cette listbox aux colonnes H, I et J (à fins de restitution ultérieure dans une fiche de synthèse)

Mais mes "retouches" du code l'invalident ou bien le résultat escompté n'apparaît pas (affiche uniquement la colonne F!)

ci joint le ode à adapter:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub ComboBox1_Click()
 
Dim F As Object
Dim MonDico As Object
Dim bd As Variant
Dim i As Integer
Dim temp As Variant
 
 
Me.TextBox1 = ComboBox1
Me.ListBox1.Clear
 
Set F = Sheets(Me.TextBox1.Text)
  Set MonDico = CreateObject("Scripting.Dictionary")
  bd = F.Range("F9:J" & F.[F65000].End(xlUp).Row)  ' tableau bd(n,1) pour rapidité
    For i = LBound(bd) To UBound(bd)
   If bd(i, 1) <> "" Then MonDico(bd(i, 1)) = ""
  Next i
  Me.ListBox1.List = MonDico.keys
  Me.ListBox1.ColumnCount = 5
 
 '--avec tri
  temp = MonDico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ListBox1.List = temp
End Sub
 
Sub Tri(a, gauc, droi)          ' Quick sort
 
Dim ref As String
Dim g As Variant
Dim d As Variant
Dim temp As Variant
 
 
 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

Quelle(s) variable(s) devrais-je modifier?

Merci d'avance pour vos lumières!

[Ben_L]

Bonjour IronHeavy,

De quelles façon souhaitez-vous élargir votre listbox ?
Vous définissez 5 colonnes pour la listbox mais ne listez que les colonnes F, H, I et J. Quelle serait la 5ème ?

Et quid du tri ?
Souhaitez-vous trier chaque colonne indépendamment ou effectuer un tri uniquement sur la base des valeurs de la colonne F ?

Ci-dessous une proposition de code avec 4 colonnes, et un tri basé uniquement sur la colonne F :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub ComboBox1_Click()
    Dim F As Worksheet, bd As Variant, i As Integer, temp As Variant
    Me.TextBox1.Value = Me.ComboBox1.Text
    Me.ListBox1.Clear
    Set F = Sheets(Me.TextBox1.Text)
    bd = F.Range("F9:J" & F.[F65000].End(xlUp).Row).Value2  ' tableau bd(n,1) pour rapidité
    For i = LBound(bd) To UBound(bd)
        If bd(i, 1) <> "" Then AddArrayElm(temp, Array(bd(i,1), bd(i,3), bd(i,4), bd(i,5)))
    Next i
    Call Tri(temp, 0, UBound(temp))
    Me.ListBox1.ColumnCount = 4
    Me.ListBox1.List = Application.Transpose(temp)
End Sub
 
Sub Tri(a, gauc, droi)          ' Quick sort
    Dim ref As String, g As Variant, d As Variant, temp As Variant, i As Integer, n As Integer
    n = UBound(a, 1)
    ref = a(0, (gauc + droi) \ 2)
    g = gauc: d = droi
    Do
        Do While a(0, g) < ref: g = g + 1: Loop
        Do While ref < a(0, d): d = d - 1: Loop
        If g <= d Then
            For i = 0 To n
                temp = a(i, g): a(i, g) = a(i, d): a(i, d) = temp
            Next i
            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
 
Private Sub AddArrayElm(Arr As Variant, Elm As Variant)
    Dim i As Long, nRow As Long, nCol As Long
    nCol = UBound(Elm)
    If Not IsArray(Arr) Then
        nRow = 0
        ReDim Arr(nCol, nRow)
    Else
        nRow = UBound(Arr, 2) + 1
        ReDim Preserve Arr(nCol, nRow)
    End If
    For i = 0 To nCol
        Arr(i, nRow) = Elm(i)
    Next i
End Sub

A tester

[IronHeavy]

Bonjour Ben_L,

j'ai besoin des 4 colonnes citées F H I J non contigües, mais en ai compté 5 "au cas où" (+ G).

A ce stade le tri serait cosmétique, mais plus ordonné de le faire par ordre alphabétique en prenant en référence la 1ère colonne (colonne F).

Votre proposition cadre donc parfaitement à mon besoin.

Après test, il s'avère que la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        If bd(i, 1) <> "" Then AddArrayElm(temp, Array(bd(i,1), bd(i,3), bd(i,4), bd(i,5)))

présente une "erreur de syntaxe"...

[Ben_L]

Je pense qu'il faut ajouter le mot clé "Call" avant le nom de la procédure.

[IronHeavy]

Super, ça fonctionne!

En revanche la suppression des doublons n'est plus de mise...

Cela fonctionnait avec la partie Sub Tri il me semble, mais ne portait que sur la colonne F.

Cela fait longtemps que mes compétences sont dépassées j'en ai peur...

[Ben_L]

Vous utilisiez un dictionnaire qui se chargeait automatiquement de la suppression des doublons.
Avec le code proposé, cela n'est plus effectif, j'en conviens.

Ci-dessous une proposition de modification de la procédure AddArrayElm pour éliminer les doublons :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub AddArrayElm(Arr As Variant, Elm As Variant)
    Dim i As Long, nRow As Long, nCol As Long
    nCol = UBound(Elm)
    If Not IsArray(Arr) Then
        nRow = 0
        ReDim Arr(nCol, nRow)
    Else
        nRow = UBound(Arr, 2) + 1
        For i = 0 To nRow - 1
            If Elm(0) = Arr(0, i) Then Exit Sub
        Next i
        ReDim Preserve Arr(nCol, nRow)
    End If
    For i = 0 To nCol
        Arr(i, nRow) = Elm(i)
    Next i
End Sub

Une différence subsiste par rapport à votre code initial : la suppression des doublons que vous aviez codé prenait en compte les valeurs associées au dernier doublons rencontré.
Ici, ce sont les valeurs liées au premier doublon qui sont conservées.

Si ce comportement n'est pas celui attendu ou si je ne suis pas clair, précisez le moi.