Alimenter 3 ListBox par un seul tableau

**apt** · 20/12/2019, 19h32

Bonjour à tous,

J'ai un tableau de 6 colonnes, et j'aimerais bien le distribuer sur 3 ListBox.

La première ListBox contiendra la première colonne du tableau

La deuxième ListBox contiendra les trois colonnes suivantes à savoir 2,3 et 4

La troisième ListBox contiendra la dernière colonne du tableau.

Est-ce possible ?

Merci d’avance.

**tototiti2008** · 20/12/2019, 20h44

Bonsoir,

un essai

**apt** · 20/12/2019, 20h56

Bonsoir tototiti,

Merci pour l'exemple.

L'alimentation des ListBox ne se fera pas directement à partir de la feuille, mais depuis un tableau dimensionné

Voici un exemple de code :

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
Private Sub TxtFix_Change()
 
    Nbmax = Sheets("Base").Range("A100000").End(xlUp).Row
 
    If Me.TxtFix <> "" Then
 
        Me.TextNom = ""
        Me.TxtMob = ""
 
        Me.ListClient.Clear
        Me.ListFix.Clear
        Me.ListMob.Clear
 
        Dim tm As Single
        tm = Timer
 
        Dim tTab(), tExtract()
        Dim iIdx%
 
        tTab = Range("A2:J" & Range("E" & Rows.Count).End(xlUp).Row).Value
        If Len(Me.TxtFix) >= 2 Then
            For x = 1 To UBound(tTab, 1)
                For y = 2 To UBound(tTab, 2)
 
                    If InStr(UCase(tTab(x, y)), UCase(Me.TxtFix.Value)) > 0 Then
 
                        iIdx = iIdx + 1
                        ReDim Preserve tExtract(7, iIdx)
 
                        tExtract(0, iIdx - 1) = tTab(x, 1) + 1
                        tExtract(1, iIdx - 1) = tTab(x, 5)
                        tExtract(2, iIdx - 1) = tTab(x, 6)
                        tExtract(3, iIdx - 1) = tTab(x, 7)
                        tExtract(4, iIdx - 1) = tTab(x, 8)
                        tExtract(5, iIdx - 1) = tTab(x, 9)
                        tExtract(6, iIdx - 1) = tTab(x, 10)
 
                        If y <> 5 Then tExtract(2, iIdx - 1) = tTab(x, y)
                        Exit For
                    End If
                Next
            Next
        End If
        Me.ListClent.List = tExtract(1)
        Me.ListFix.List = tExtract(2) & tExtract(3) & tExtract(4)
        Me.ListMob.List = tExtract(5) & tExtract(6)
 
        MsgBox "Durée d'exécution: " & Timer - tm & " s"
    End If
 
End Sub

**tototiti2008** · 20/12/2019, 22h34

Re,

à tester

Dans un module

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Function ColTab(ByVal Tablo, ColDeb As Long, ColFin As Long)
Dim NouvTab(), i As Long, j As Long
    ReDim NouvTab(LBound(Tablo, 1) To UBound(Tablo, 1), 1 To ColFin - ColDeb + 1)
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        For j = ColDeb To ColFin
            NouvTab(i, j - ColDeb + 1) = Tablo(i, j)
        Next j
    Next i
    ColTab = NouvTab
End Function

Chargement des listes

Code :

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

1
2
3
4
5
6
7
8
 
...
        Me.ListClent.List = coltab(tExtract,1,1)
        Me.ListFix.List = coltab(tExtract,2,4)
        Me.ListMob.List = coltab(tExtract,5,6)
Me.ListFix.columncount=3
Me.ListMob.columncount=2
...

**apt** · 21/12/2019, 00h00

Salut tototiti,

J'ai eu une erreur d'exécution '9' :

L'indice n'appartient pas à la selection

Sur cette ligne :

Code :

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

ReDim NouvTab(LBound(Tablo, 1) To UBound(Tablo, 1), 1 To ColFin - ColDeb + 1)

**tototiti2008** · 21/12/2019, 00h27

Re,

Après lecture plus approfondie de ton code, tExtract semble être dans l'autre sens

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Function LigTab(ByVal Tablo, LigDeb As Long, LigFin As Long)
 
 
Dim NouvTab(), i As Long, j As Long
    ReDim NouvTab(1 To LigFin - LigDeb + 1, LBound(Tablo, 2) To UBound(Tablo, 2))
    For j = LBound(Tablo, 2) To UBound(Tablo, 2)
        For i = LigDeb To LigFin
            NouvTab(i - LigDeb + 1, j) = Tablo(i, j)
        Next i
    Next j
    LigTab = NouvTab
End Function

Code :

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

1
2
3
4
5
6
 
Me.ListClent.column = ligtab(tExtract,1,1)
        Me.ListFix.column = ligtab(tExtract,2,4)
        Me.ListMob.column = ligtab(tExtract,5,6)
Me.ListFix.columncount=3
Me.ListMob.columncount=2

**apt** · 21/12/2019, 00h47

Même erreur d'exécution sur la ligne de code :

Code :

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

ReDim NouvTab(1 To LigFin - LigDeb + 1, LBound(Tablo, 2) To UBound(Tablo, 2))

**tototiti2008** · 21/12/2019, 00h56

Alors il va falloir que tu analyses le contenu de tExtract, car je ne sais pas en l'état

**apt** · 21/12/2019, 01h09

Si je tape une seule lettre ou numéro dans le TextBox de recherche, le tableau tExtract sera vide selon la condition :

Code :

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

If Len(Me.TxtFix) >= 2 Then

Il fallait insérer le code de remplissage des ListBox avant le (End if) de cette condition

Je vais refaire le test avec les deux fonctions.

**boisgontierjacques** · 21/12/2019, 11h05

Bonjour,

Cette écriture, plus classique, est compatible avec un tableau non structuré. En outre, le tableau peut être déplacé sur un autre onglet.

Code :

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

1
2
3
4
5
6
Private Sub UserForm_Initialize()
  ListBox1.List = Application.Index([Tableau1], , 1).Value
  ListBox2.ColumnCount = 3
  ListBox2.List = Application.Index([Tableau1], , 2).Resize(, 3).Value
  ListBox3.List = Application.Index([Tableau1], , 6).Value
End Sub

S'il s'agit d'un Array()

Code :

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

1
2
3
4
5
6
7
8
Private Sub UserForm_Initialize()
  Tbl = [Tableau1].Value
  n = UBound(Tbl)
  ListBox1.List = Application.Index(Tbl, , 1)
  ListBox2.ColumnCount = 3
  ListBox2.List = Application.Index(Tbl, Evaluate("Row(1:" & n & ")"), Array(2, 3, 4))
  ListBox3.List = Application.Index(Tbl, , 6)
End Sub

Boisgontier

**OrDonc** · 21/12/2019, 12h23

Bonjour …

Dès que le tableau structuré est défini, son nom et ceux des titres (visibles ou pas) sont mémorisés.
Autant les utiliser (VBA ou pas) : le tableau étant nommé Tb, pour les listes :

Code :

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

1
2
3
4
5
Private Sub UserForm_Initialize()
    ListBox1.List = [Tb].Columns(1).Value
    ListBox2.List = [Tb[[b]:[d]]].Value        ‘avec le nom des titres plutôt que l’index
    ListBox3.List = [Tb].Columns([Tb].Columns.Count).Value
End Sub

Maintenant on peut vouloir éviter les doublons, les vides

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub UserForm_Initialize()
    Dim D As Object, R As Range
    'sans doublon
    Set D = CreateObject("Scripting.Dictionary")
    For Each R In [Tb].Columns(1).Cells: D(R.Value) = "": Next
    ListBox1.List = D.keys
    'multicolonnes (continues), en passant par leur nom et non leur index
    ListBox2.List = [Tb[[b]:[d]]].Value
    'sans vide
    ListBox3.List = [Tb].Columns(6).Cells.SpecialCells(2).Value
End Sub

**apt** · 21/12/2019, 18h40

Bonsoir tototiti, Boisgontier, orDonc, le forum,

J'ai essayé d'adapter la solution de boisgontier, puisqu'il y a une fonction prédéfinie qui sélectionne directement la colonne d'un tableau, mais voila les listes sont alimentées d'une manière inverse

**boisgontierjacques** · 21/12/2019, 19h38

Bonsoir,

Fonction de récupération de colonnes discontinues d'un Array() plus rapide.

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
 
Sub Essai()
  Set f = Sheets("bd")
  Tbl = f.Range("A1:F" & f.[A65000].End(xlUp).Row).Value
  Tbl2 = FonctionColonnesArray(Tbl, "2,5,4")
  [M2].Resize(UBound(Tbl2), UBound(Tbl2, 2)) = Tbl2
End Sub
 
Function FonctionColonnesArray(Tbl, colonnesRecup)
  ColRecup = Split(colonnesRecup, ",")
  n = UBound(Tbl)
  ReDim TblResult(1 To n, 1 To UBound(ColRecup) + 1)
  j = 0
  For Each k In ColRecup
      j = j + 1
      For i = 1 To UBound(Tbl): TblResult(i, j) = Tbl(i, k): Next i
   Next k
   FonctionColonnesArray = TblResult
End Function

Boisgontier

**boisgontierjacques** · 21/12/2019, 20h34

Bonsoir,

Je propose une autre approche

Une recherche intuitive multi-mots multi-colonnes

Boisgontier

**apt** · 22/12/2019, 18h40

Bonjour Boisgontier,

Pour bien afficher notre tableau avec Application.Index(), peut-on bien écrire ?

Code :

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

ListBox2.List = Application.Index(Tbl, Array(2, 3, 4), Evaluate("Row(1:" & n & ")"))

J'ai trouvé très bonne l’idée pour une recherche multiple

Je vais essayé de la comprendre

**OrDonc** · 22/12/2019, 19h21

Bonsoir ...

Voici une toute autre approche mais sans aucune ListBox - avec une saisie contrôlée des numéros de téléphone (Module de Classe).
Les contrôles en vue de modification(s), de nouvelle(s) saisie(s) lors de la sélection d’une ligne de Listbox ne sont pas à rajouter !

**apt** · 28/12/2019, 18h20

Bonsoir OrDonc,

Merci pour la nouvelle idée.

Parmi les tests, quand je double clique sur la ligne 2 (ligne des en-têtes) pour ajouter une ligne, cette dernière après le clique sur le bouton ajouter, les infos sont ajoutées sur la ligne 2 au lieu de la dernière ligne du tableau.

**OrDonc** · 29/12/2019, 20h49

Re …

Pardon pour l’erreur : je n’ai pas joint le bon fichier

.

Il suffit, dans le précédent d’ajouter 2 instructions et d’en corriger une autre

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
Private Sub UserForm_Initialize()
   …    
      If R.Address = [Tb].Item(0, 1).Address Then
          Me.Caption = "Mode création": CE.Caption = "8": CS.Visible = 0
          L = [Tb].Rows.Count + 1
          Sl.Visible = 0 ‘à ajouter
      Else
  …
   End Sub
    Private Sub Sl_Change()
      If Sl = 0 Then Sl = Sl.Max - 1
      If Sl = Sl.Max Then Sl = 1
      L = Sl  ‘à ajouter
       For n = 1 To 9: Me("C" & n) = [Tb].Item(L, n): Next
  End Sub
  Private Sub CE_Click()
      For n = 1 To 9
          ‘remplacer Sl par L
          [Tb].Item(L, n) = Me("C" & n)           
          If n > 4 And Me("C" & n) <> "" Then [Tb].Item(L, n) = Me("C" & n)
      Next
  End Sub

Remarque le cas de lignes en doublon n’est pas traité

**Pierre Fauconnier** · 01/01/2020, 18h18

Salut.

Si cela t'intéresse, j'ai modélisé les échanges Table/userform dans cette contribution. Elle généralise l'approche par l'utilisation d'une classe d'échange. Tu peux bien entendu l'utiliser sur base d'un double-click sur une ligne de ta table.

**apt** · 02/01/2020, 19h32

Bonsoir OrDonc, Pierre,

J'ai corrigé le code et fonctionne bien maintenant. Merci

Mais pour un annuaire qui contient des centaines de lignes, cela peut être gênant de parcourir toute la liste pour trouver la ligne correspondante pour une éventuelle mondialisation par exemple

Pierre >> Je vais lire ce qu'il y a dans le lien proposé. Merci.

Alimenter 3 ListBox par un seul tableau

Macros et VBA Excel

Discussions similaires

Partager

Partager