Alimentation d'une LISTBOX par une variable tableau triée

**Osaka2017** · 21/06/2019, 15h17

Bonjour à toutes et à tous,

Le fichier suivant permet d'afficher une liste de codes triés relative à la commande (col E) encodée dans le textbox.

Tous les codes (col F) ne sont pas contigus et la base de données originale contient plus de 50.000 lignes.

Le code semble fonctionnel mais est-il correct pour autant (utilité de passer par 2 dimensions, utilisation d'un dictionnaire ....)

Merci à vous

**boisgontierjacques** · 21/06/2019, 16h41

Bonjour,

La recherche directement sur les cellules et AddItem ne vont pas comtribuer à accélérer le code.

Avec cette version:
-On peut choisir les colonnes affichées & l'ordre d'affichage

Code :

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

 ColVisu = Array(1, 2, 3, 5, 6, 7, 8, 10, 11, 12, 13, 15) ' Colonnes à visualiser (adapter)

-Choisir la colonne de tri
-On pourrait remplacer le textBox par un comboBox

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Compare Text
Dim f, TblBD, ColVisu(), NbCol
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set Rng = f.Range("A2:Z" & f.[A65000].End(xlUp).Row)
  TblBD = Rng.Value ' rapidité
  ColVisu = Array(1, 2, 3, 5, 6, 7, 8, 10, 11, 12, 13, 15) ' Colonnes à visualiser (adapter)
  NbCol = UBound(ColVisu) + 1
  ReDim TblTitreListBox(1 To UBound(ColVisu) + 1)
  TitreBD = Application.Transpose(Rng.Offset(-1).Resize(1).Value)
  For i = LBound(ColVisu) To UBound(ColVisu)
    TblTitreListBox(i + 1) = TitreBD(ColVisu(i), 1)
  Next i
  Me.ComboTri.List = TblTitreListBox
  '---- Contenu ListBox initial
  EnteteListBox
  Affiche
End Sub
 
Private Sub TextBox1_Change()
  Affiche
End Sub
 
Sub Affiche()
  temp = "*" & Me.TextBox1 & "*"
  Dim Tbl(): n = 0
  For i = 1 To UBound(TblBD)
    If TblBD(i, 5) Like temp Then
      n = n + 1: ReDim Preserve Tbl(1 To NbCol, 1 To n)
      c = 0
      For Each k In ColVisu
        c = c + 1: Tbl(c, n) = TblBD(i, k)
      Next k
    End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub
 
Sub EnteteListBox()
  x = Me.ListBox1.Left + 8
  y = Me.ListBox1.Top - 12
  For Each k In ColVisu
    Set Lab = Me.Controls.Add("Forms.Label.1")
    Lab.Caption = f.Cells(1, k)
    Lab.Top = y
    Lab.Left = x
    x = x + f.Columns(k).Width * 1#
    temp = temp & f.Columns(k).Width * 1# & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
  Me.ListBox1.ColumnWidths = temp
End Sub
 
Private Sub ComboTri_click()
  Dim Tbl()
  colTri = Me.ComboTri.ListIndex
  Tbl = Me.ListBox1.List
  TriMultiCol Tbl, LBound(Tbl), UBound(Tbl), colTri
  Me.ListBox1.List = Tbl
End Sub
 
Sub TriMultiCol(a, gauc, droi, colTri) ' Quick sort
  ref = a((gauc + droi) \ 2, colTri)
  g = gauc: d = droi
  Do
    Do While a(g, colTri) < ref: g = g + 1: Loop
    Do While ref < a(d, colTri): d = d - 1: Loop
    If g <= d Then
       For c = LBound(a, 2) To UBound(a, 2)
          temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then TriMultiCol a, g, droi, colTri
   If gauc < d Then TriMultiCol a, gauc, d, colTri
End Sub

Boisgontier