ComboBox Affichage Liste

Version imprimable

Bonjour,

Je cherche un moyen d'afficher une liste dans une combobox à partir de colonne différente en VBA car à partir de Validation des données Excel ne veut pas prendre des valeurs de colonne différente.

Voici un bout de code que j'ai fais, mais qui ne fais pas ce que je veux...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect([A2:A16], Target) Is Nothing And Target.Count = 1 Then With Worksheets("bd").ComboBox1 Me.ComboBox1.Height = Target.Height + 3 Me.ComboBox1.Width = Target.Width Me.ComboBox1.Top = Target.Top Me.ComboBox1.Left = Target.Left Me.ComboBox1 = Target Me.ComboBox1.Visible = True Me.ComboBox1.Activate ' Me.ComboBox1.List = Union("toto") For A = 1 To Range("F1:I23").Rows.Count ' .AddItem Range("A" & A) .List(A, 0) = Range("I" & A) .List(A, 0) = Range("G" & A) Next End With Else Me.ComboBox1.Visible = False End If End Sub
Code:

1 2 3 4 5 Private Sub ComboBox1_Change() If Me.ComboBox1 <> "" Then ActiveCell.Value = Me.ComboBox1 End If End Sub
Si quelqu'un peut m'aider cela serait cool ! Merci
PS : Je veux avoir la possibilité d'écrire ce que je veux dans la combobox voici la raison pour laquelle je n'ai pas fais de Listbox.

Merci de votre aide

Bonjour,

une solution possible:

à la place de

Code:

1
2
3
4
5
 For A = 1 To Range("F1:I23").Rows.Count
  ' .AddItem Range("A" & A)
    .List(A, 0) = Range("I" & A)
    .List(A, 0) = Range("G" & A)
 Next

copier:

Code:

1
2
3
4
5
6
7
8
9
10
T = Range("A1:I23")
ReDim T1(1 To UBound(T, 1), 1 To 3)
For i = LBound(T, 1) To UBound(T, 1)
    T1(i, 1) = T(i, 1)
    T1(i, 2) = T(i, 9)
    T1(i, 3) = T(i, 7)
Next
.ColumnCount = 3
..ColumnWidths = "30;30;30"  'à adapter
.List = T1

Au début de Worksheet_SelectionChange déclarer les variables:

Code:

Dim T, T1(), i as Integer

A+

11/03/2019, 14h39
Nosperato
Merci beaucoup de votre réponse Algoplus cependant ce n'est pas le résultat voulu...

Lors de l'application de votre code au mien, je récupère bien les données dans la combobox mais cela concatène plusieurs données sous forme de liste et cela affiche les données de la colonne A.

Mon objectif pour être plus explicite :
- Sur la colonne de A2 à A16 une ComboBox1 se créer.
- Lors du clique sur la cellule A2 une liste doit apparaître(ComboBox1).
- Cette liste doit être alimenter par les données trouvées de G1:G23 et de I1:I11 sans blanc
Exemple :

De G1 à G23 j'ai comme donnée :
Toto
Tata
Tati

De I1 à I11 j'ai comme donnée :
Alpha
Beta

Omega

La ComboBox1 qui est en A2 par exemple doit afficher sous forme de liste :
Toto
Tata
Tati
Alpha
Beta
Omega

Sans les blanc et triée mais ça j'arrive à le faire c'est de pouvoir rassembler dans une ComboBox1 les données de G1:G23 et I1:I11

Merci de votre aide

Aaah oui, je n'avais vraiment rien compris !!

alors, si j'ai mieux compris:

Code:

1
2
3
4
5
6
7
 For A = 1 To 23
     if Range("G" & A)<>"" then .AddItem Range("G" & A)
 next
 
 For A = 1 To 11
     if Range("I" & A)<>"" then .AddItem Range("I" & A)
 Next

A+

Merci Algoplus ! C'est exactement cela que je voulais au top !

Par contre petit problème, lorsque la ComboBox1 du champ A2 est active la liste est totalement normal, sauf que si on active par la suite la ComboBox1 du champ A3 on se retrouve la liste en double, je me suis dis pas de problème, je fais un ComboBox1.Clear jusqu’à la parfait ça marche, j'intègre maintenant ma fonction pour trié mes données sous forme alphabétique, et la le trie fonctionne parfaitement mais mon ComboBox1.Clear ne fonctionne et je me retrouve avec une liste assez conséquente...

Donc la je sèche, car je ne sais pas trop ou mettre mon ComboBox1.Clear...
~~EDIT 16h30 : j'ai réussi à placer mon ComboBox1.Clear mais la fonction trier ne fonctionne toujours pas fin à moitier...~~
Voici mon code à jour :
Code:

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 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i As Integer, j As Integer Dim strTemp As String If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then For a = 1 To 23 If Range("G" & a) <> "" Then ComboBox1.AddItem Range("G" & a) Next For a = 1 To 15 If Range("I" & a) <> "" Then ComboBox1.AddItem Range("I" & a) Next Me.ComboBox1.Height = Target.Height + 3 Me.ComboBox1.Width = Target.Width Me.ComboBox1.Top = Target.Top Me.ComboBox1.Left = Target.Left Me.ComboBox1 = Target Me.ComboBox1.Visible = True Me.ComboBox1.Activate With Me.ComboBox1 For i = 0 To .ListCount - 1 For j = 0 To .ListCount - 1 If .List(i) < .List(j) Then strTemp = .List(i) .List(i) = .List(j) .List(j) = strTemp End If Next j Next i End With Else Me.ComboBox1.Visible = False ComboBox1.Clear End If End Sub
La fonction trie ne trie plus si j'ajoute une nouvelle donnée je ne comprend pas :?
EDIT 16h00 pour la fonction trie :
Je ne sais pas pourquoi mais la fonction trie s'effectue de I2 à I11 et les données de I12 à I15 sont également triées mais totalement indépendamment :weird:

EDIT 17h26 : Le trie + ComboBox1.Clear est opérationnel je me suis débrouillé et j'ai trouvé mon erreur

Par contre j'ai toujours une question si quelqu'un peut m'aider :
Comment fait-on pour que si je tape la première lettre dans la ComboBox1 il m'affiche uniquement les données par la lettre tapé ?
Exemple :
J'ai plusieurs données : Alpha ; Allo ; AA ; beta
Si je tape A je voudrai que dans la liste il m'affiche uniquement : Alpha ; Allo et AA.

Merci de votre aide !!

11/03/2019, 19h26
boisgontierjacques

1 pièce(s) jointe(s)

Bonsoir,

>Si je tape A je voudrai que dans la liste il m'affiche uniquement : Alpha ; Allo et AA.

Voir exemple de saisie intuitive dans un ComboBox en PJ

Boisgontier

1 pièce(s) jointe(s)

Bonjour,

Cette liste doit être alimentée par les données trouvées de G1:G23 et de I1:I11 sans blanc

Code:

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
Dim a(), f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("bd")
  Set zSaisie = Range("A2:A16")
  If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
    Set d = CreateObject("scripting.dictionary")
    For Each c In f.Range("G1:G23,I1:I13")
      If c.Value <> "" Then d(c.Value) = ""
    Next c
    a = Application.Transpose(d.keys)
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    mémo = Target.Address
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub
 
Private Sub ComboBox1_Change()
  If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
    Set d1 = CreateObject("Scripting.Dictionary")
    tmp = UCase(Me.ComboBox1) & "*"
    For Each c In a
      If UCase(c) Like tmp Then d1(c) = ""
    Next c
    Me.ComboBox1.List = d1.keys
    Me.ComboBox1.DropDown
  End If
  ActiveCell.Value = Me.ComboBox1
End Sub

Boisgontier

12/03/2019, 11h28
Nosperato

Merci beaucoup boisgontierjacques de votre aide, cela fonctionne ! Fin presque..

Le trie ne s'effectue plus, il s'effectue mais lorsque je change de zone de A2 à A3 vice versa, les données ne sont pas figées et change toute seule... :weird:

Petit à petit j'y arrive !

EDIT 11h58 : J'ai réussi

Pour obtenir une liste a() triée :

Code:

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
Dim a(), f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("bd")
  Set zSaisie = Range("A2:A16")
  If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
    Set d = CreateObject("scripting.dictionary")
    For Each c In f.Range("G1:G23,I1:I13")
      If c.Value <> "" Then d(c.Value) = ""
    Next c
    a = d.keys
    Tri a, LBound(a), UBound(a)
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    mémo = Target.Address
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub
 
Private Sub ComboBox1_Change()
  If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
    Set d1 = CreateObject("Scripting.Dictionary")
    tmp = UCase(Me.ComboBox1) & "*"
    For Each c In a
      If UCase(c) Like tmp Then d1(c) = ""
    Next c
    Me.ComboBox1.List = d1.keys
    Me.ComboBox1.DropDown
  End If
  ActiveCell.Value = Me.ComboBox1
End Sub
 
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then
    If IsError(Application.Match(ActiveCell, a, 0)) Then ActiveCell = ""
    ActiveCell.Offset(1).Select
  End If
End Sub
 
Sub Tri(a, gauc, droi)  ' Quick sort
  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

12/03/2019, 14h56
Nosperato

Merci boisgontierjacques, j'ai réussi avant même que vous m'aidez ! Aha

Je suis maintenant sur un formulaire modification/suppression de données !

Petit problème j'essaie maintenant de pouvoir modifier une ligne et de la supprimer dans un formulaire sauf que cela fait un peu n'importe quoi, car mes tableaux ne commencent pas à partir de la colonne A mais à partir de la colonne E jusqu'à K et j'ai au total 5 tableau .. du coup j'ai énormément de problème et d'echec...

Si quelqu'un peut m'aider voici mon code :

Code:

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
Dim f, ligneEnreg
 
 
Private Sub UserForm_Initialize()
 
   ComboBox1.AddItem "Achat"
   ComboBox1.AddItem "Autres éléments"
   ComboBox1.AddItem "Location"
   ComboBox1.AddItem "Matériel"
   ComboBox1.AddItem "Personnel"
End Sub
 
Private Sub ComboBox1_Click()
 
   If ComboBox1.Value = "Achat" Then
   Set f = Sheets("Feuille de prix")
   Clé = f.Range("E2:E" & f.[E65000].End(xlUp).Row)
  '-------------avec tri---------------
  Call Tri(Clé, LBound(Clé), UBound(Clé))
  Me.ComboBox2.List = Clé
  Me.ComboBox2.ListIndex = -1
  CommandButton2_Click
 
 
  ElseIf ComboBox1.Value = "Autres éléments" Then
  Clé = f.Range("M2:M" & f.[M65000].End(xlUp).Row)
  '-------------avec tri---------------
  Call Tri(Clé, LBound(Clé), UBound(Clé))
  Me.ComboBox2.List = Clé
  Me.ComboBox2.ListIndex = -1
  CommandButton2_Click
 
 
  ElseIf ComboBox1.Value = "Location" Then
  Clé = f.Range("T2:T" & f.[T65000].End(xlUp).Row)
  '-------------avec tri---------------
  Call Tri(Clé, LBound(Clé), UBound(Clé))
  Me.ComboBox2.List = Clé
  Me.ComboBox2.ListIndex = -1
  CommandButton2_Click
 
 
  ElseIf ComboBox1.Value = "Matériel" Then
  Clé = f.Range("AB2:AB" & f.[AB65000].End(xlUp).Row)
  '-------------avec tri---------------
  Call Tri(Clé, LBound(Clé), UBound(Clé))
  Me.ComboBox2.List = Clé
  Me.ComboBox2.ListIndex = -1
  CommandButton2_Click
 
 
  ElseIf ComboBox1.Value = "Personnel" Then
  Clé = f.Range("AJ2:AJ" & f.[AJ65000].End(xlUp).Row)
  '-------------avec tri---------------
  Call Tri(Clé, LBound(Clé), UBound(Clé))
  Me.ComboBox2.List = Clé
  Me.ComboBox2.ListIndex = -1
  CommandButton2_Click
  End If
 
End Sub
 
Private Sub ComboBox2_Click()
 
If ComboBox1.Value = "Achat" Then
   ligneEnreg = Sheets("Feuille de prix").Range("E:K").Find(ComboBox2, LookIn:=xlValues).Row
   Me.TextBox1 = f.Cells(ligneEnreg, 6)
   Me.TextBox6 = f.Cells(ligneEnreg, 11)
   Me.TextBox4 = f.Cells(ligneEnreg, 9)
   Me.TextBox3 = f.Cells(ligneEnreg, 7)
   Me.TextBox2 = f.Cells(ligneEnreg, 8)
   Me.TextBox5 = f.Cells(ligneEnreg, 5)
 
 
ElseIf ComboBox1.Value = "Autres éléments" Then
 
 
ElseIf ComboBox1.Value = "Location" Then
 
ElseIf ComboBox1.Value = "Matériel" Then
 
ElseIf ComboBox1.Value = "Personnel" Then
 
End If
End Sub
Private Sub CommandButton3_Click()
  If Me.TextBox5 = "" Then
     MsgBox "Saisir un nom"
     Me.TextBox5.SetFocus
     Exit Sub
  End If
 
  '--- Transfert Formulaire dans BD
   f.Cells(ligneEnreg, 6) = Me.TextBox1
   f.Cells(ligneEnreg, 8) = Me.TextBox2
   f.Cells(ligneEnreg, 7) = Me.TextBox3
   f.Cells(ligneEnreg, 9) = Me.TextBox4
   f.Cells(ligneEnreg, 11) = Me.TextBox6
   f.Cells(ligneEnreg, 5) = Application.Proper(Me!TextBox5)
   UserForm_Initialize
End Sub
 
 
Private Sub CommandButton2_Click()
  ligneEnreg = f.[E65000].End(xlUp).Row + 1
  Me.TextBox5 = ""
End Sub
 
Private Sub CommandButton4_Click()
 If MsgBox("Etes vous sûr de suppimer " & f.Cells(ligneEnreg, 2) & "?", vbYesNo) = vbYes Then
   ncol = 7
   f.Cells(ligneEnreg, 1).Resize(, ncol).Delete Shift:=xlUp
   UserForm_Initialize
 End If
End Sub
Private Sub b_fin_Click()
  Unload Me
End Sub
 
Sub Tri(a, gauc, droi) ' Quick sort
   ref = a((gauc + droi) \ 2, 1)
   g = gauc: d = droi
   Do
     Do While a(g, 1) < ref: g = g + 1: Loop
     Do While ref < a(d, 1): d = d - 1: Loop
     If g <= d Then
       temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = 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

Je voudrai également les Cells car compter le nombre de colonne pour chacun de mes tableaux cela risque de me prendre longtemps, je ne sais pas si il y a possibilité de le faire sur une plage par exemple de E à K ; de M à R etc. Sachant que la colonne E correspond à la textbox5, la colonne F textbox4 etc... Egalement pour l'autre tableau le textbox5 correspond à la colonne M et ainsi de suite afin d'éviter de faire les Cells...

12/03/2019, 20h23
boisgontierjacques

1 pièce(s) jointe(s)

Bonsoir,

En utilisant des tableaux structurés dynamiques, on s'affranchit de leur emplacement. On utilise leurs noms.

Exemple en PJ de formulaire multi-bd.

Boisgontier
14/03/2019, 11h42
Nosperato

Bonjour boisgontierjacques,

J'ai enfin réussi à mettre en oeuvre vote code avec le mien, cependant j'ai une question essentielle que je n'ai pas trouvée dans votre code.

Sur mes différentes bases de données par exemple BD1 et BD2, sur chacune de ces feuilles j'ai des catégories par exemple Catégorie BD1 et Catégorie BD2, et quand je modifie une ligne, on modifie uniquement la ligne qui se trouve dans la base de données en question, sauf que ce que je voudrais c'est que si je me trompe lors de l'insertion d'une nouvelle ligne dans la BD1, je voudrais pouvoir transférer la donnée sur la BD2 en fonction de la catégorie, je m'explique :
J'ai 2 bases de données sur 2 feuilles différentes dont leur nom est BD1 et BD2, j'ai inséré une ligne dans la BD1 avec mes différentes colonnes, sauf par erreur je me suis trompé, sur la base de données en question et afin d'éviter de supprimer et de recréer une nouvelle ligne, je voudrais que lors de la modification, je puisse avoir un champ permettant de transférer la ligne en question de BD1 vers BD2

Si vous pouvez m'éclairer

Merci beaucoup