Discussion :

[tony847]

Bonsoir

J’ai un classeur, qui contient 3 feuilles :
Feuil1 commandbouton, Feuil2 model, Base de donnée.
Je voudrai qu’en cliquant sur le bouton de commande cela m’ouvre une boite de dialogue (USERFORM). Et en faisant défilée le combox1 cela me sélectionne les données se trouvant dans la feuil3 colonneA. Si je choisi de pointer sur une des valeurs cela à des répercution sur le combox2, combox3, 4, 5.
Et si je garde la valeur pointer dans le combox1 et je choisi de pointer une valeur dans le combox2 cela me sélectionne seulement les valeurs concernée par le combox1. Le but est d'affiner la recherche sur les autres combox et ainsi de suite.

[Pierre Fauconnier]

Bonsoir.

Pas certain d'avoir compris...

Tu veux que les combo s'adaptent en cascade?

[tony847]

je voudrai quand pointant sur un combox cela me sélectionne seulement les valeur concernés par ce combox dans les autres combox

[Pierre Fauconnier]

J'ai regardé ton fichier

Je pense qu'utiliser un TCD sur des données externes n'est pas une bonne idée.

Je préfèrerais une "table à plat" qui renvoie en colonne 1 la position, en colonne 2 le bâtiment, en colonne 3 la partie, etc...

C'est alors bien plus simple de créer un code pour les combo?

Est-ce faisable d'organiser les données dans Excel de cette manière?

[tony847]

voilà j'ai remplacer le TCD par des colonnes simple

[Gorfael]

Salut
En réponse à ton MP qui concerne ce sujet je crois, une proposition.
Évite les MP. Si tout le monde fais comme toi, ma Bal va exploser.
A+

[tony847]

en première feuille j'ai mon application ma base de donné se trouve dans la feuille 2.
Les AddItem ne fonctionne pas

Tu fais apparaitre combox1 à combox4 un aprés l'autre(alors que je veux les 4 combox affiché en meme temps) , ce que je veux exactement faire. c'est qu'en pointant sur n'importe lequelle des combox cela m'affiche la liste égal à la valeur du combox.

Je veux par la suite les édités sur une feuille .

[tony847]

J'ai regardé ton fichier

Je pense qu'utiliser un TCD sur des données externes n'est pas une bonne idée.

Je préfèrerais une "table à plat" qui renvoie en colonne 1 la position, en colonne 2 le bâtiment, en colonne 3 la partie, etc...

C'est alors bien plus simple de créer un code pour les combo?

Est-ce faisable d'organiser les données dans Excel de cette manière?

oui c'est faisable l'important pour moi c d'afficher dans la boite de dialogue les valeurs pointer(ou sélectionner) et ensuite de les éditer.
Si ta méthode reprend cette logique je suis preneur
merci

[tony847]

bonsoir,

j'aimrais effacer les doublons dans mon programme ,
comment faire?
voici mon 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
Dim i As Integer
Dim ValTable As String
 
Sub Lanc_Appli()
    'affiche la boite
    UserForm4.Show
End Sub
 
 
Sub Init()
    'initialisation de la boite
    'Ajoute des valeurs de la colonne "N" dans la liste 1
    i = 1
    'Tant qu'on trouve une valeur
    Do While Sheets("Mod feuille").Range("N3").Offset(i, 0) <> ""
        UserForm4.Localité.AddItem Sheets("Mod feuille").Range("N3").Offset(i, 0)
        i = i + 1
    Loop
End Sub
 
 
 
Sub Rempliste()
    'efface les données de la liste2
    UserForm4.Unité.Clear
    'Récupération de la valeur de la liste1
    ValTable = UserForm4.Localité
    i = 1
    'Boucle "Do While-Loop" pour chaque valeur de la colonne "O"
    Do While Sheets("Mod feuille").Range("O3").Offset(i, 0) <> ""
        'si la valeur de la colonne "O" est identique à la valeur de la liste 1,
        'on ajoute sa valeur correspondante de la colonne "P" dans la liste 2.
        If Sheets("Mod feuille").Range("O3").Offset(i, 0) = ValTable Then
            UserForm4.Unité.AddItem Sheets("Mod feuille").Range("P3").Offset(i, 0)
     'si la valeur de la colonne "P" est identique à la valeur de la liste 2,
        'on ajoute sa valeur correspondante de la colonne "Q" dans la liste 3.
            UserForm4.Périodicité.AddItem Sheets("Mod feuille").Range("Q3").Offset(i, 0)
 
        End If
    i = i + 1
    Loop
End Sub

[oscar.cesar]

bonjour a tous , bonsoir tony

ci_joint le code que j'ai realise avec l'aide du forum.

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
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
134
135
136
137
138
139
140
141
142
143
 
Private Sub recherche() 'recherche multicritere
Dim lignedebut As Integer
Dim derniereligne As Integer
 
'Dim jj As Long
Dim Cu1$, Cu2$, Cu3$, Cu4$, Cu5$, Cu6$, cu7$, Cu8$, Cu9$, Cu10$, Cu11$, Cu12$, Cu13$, Cu14$, Cu15$, Cu16$, Cu17$, Cu18$, Cu19$
Cu1 = ""
Cu1 = ""
Cu2 = ""
Cu3 = ""
Cu4 = ""
Cu5 = ""
Cu6 = ""
cu7 = ""
Cu8 = ""
Cu9 = ""
Cu10 = ""
Cu11 = ""
Cu12 = ""
Cu13 = ""
Cu14 = ""
Cu15 = ""
Cu16 = ""
Cu17 = ""
Cu18 = ""
Cu19 = ""
 
ListView1.ListItems.Clear ' efface le contenu de la listviews
 
derniereligne = Sheets("feuil2").Range("A4").End(xlDown).Row 'derniere ligne occupee dans colonne A
 
Dim lig As Integer ' compteur ligne listview
 lig = 1
Dim coul
 
coul = vbRed
For lignedebut = 4 To derniereligne 'on test le contenu des combobox
 
     If ComboBox24.Value <> "" Then Cu1 = ComboBox24.Value Else Cu1 = Sheets("feuil2").Cells(lignedebut, 2)
     If ComboBox6.Value <> "" Then Cu2 = ComboBox6.Value Else Cu2 = Sheets("feuil2").Cells(lignedebut, 1)
     If ComboBox5.Value <> "" Then Cu3 = ComboBox5.Value Else Cu3 = Sheets("feuil2").Cells(lignedebut, 4)
     If ComboBox26.Value <> "" Then Cu4 = ComboBox26.Value Else Cu4 = Sheets("feuil2").Cells(lignedebut, 3)
     If ComboBox14.Value <> "" Then Cu5 = ComboBox14.Value Else Cu5 = Sheets("feuil2").Cells(lignedebut, 20)
     If ComboBox15.Value <> "" Then Cu6 = ComboBox15.Value Else Cu6 = Sheets("feuil2").Cells(lignedebut, 21)
     If ComboBox16.Value <> "" Then cu7 = ComboBox16.Value Else cu7 = Sheets("feuil2").Cells(lignedebut, 22)
     If ComboBox17.Value <> "" Then Cu8 = ComboBox17.Value Else Cu8 = Sheets("feuil2").Cells(lignedebut, 19)
     If ComboBox23.Value <> "" Then Cu9 = ComboBox23.Value Else Cu9 = Sheets("feuil2").Cells(lignedebut, 9)
     If ComboBox22.Value <> "" Then Cu10 = ComboBox22.Value Else Cu10 = Sheets("feuil2").Cells(lignedebut, 11)
     If ComboBox19.Value <> "" Then Cu11 = ComboBox19.Value Else Cu11 = Sheets("feuil2").Cells(lignedebut, 10)
     If ComboBox9.Value <> "" Then Cu12 = ComboBox9.Value Else Cu12 = Sheets("feuil2").Cells(lignedebut, 16)
     If ComboBox8.Value <> "" Then Cu13 = ComboBox8.Value Else Cu13 = Sheets("feuil2").Cells(lignedebut, 17)
 
     If ComboBox3.Value <> "" Then Cu14 = ComboBox3.Value Else Cu14 = Sheets("feuil2").Cells(lignedebut, 5)
     If ComboBox27.Value <> "" Then Cu15 = ComboBox27.Value Else Cu15 = Sheets("feuil2").Cells(lignedebut, 7)
     If ComboBox29.Value <> "" Then Cu16 = ComboBox29.Value Else Cu16 = Sheets("feuil2").Cells(lignedebut, 34)
     If ComboBox28.Value <> "" Then Cu17 = ComboBox28.Value Else Cu17 = Sheets("feuil2").Cells(lignedebut, 8)
     If ComboBox30.Value <> "" Then Cu18 = ComboBox30.Value Else Cu18 = Sheets("feuil2").Cells(lignedebut, 33)
     If ComboBox4.Value <> "" Then Cu19 = ComboBox4.Value Else Cu19 = Sheets("feuil2").Cells(lignedebut, 6)
 
 
    'test final avec toute les conditon imbriquee
    'affichage  dans listbox en multicolonne
    If Sheets("feuil2").Cells(lignedebut, 2) = Cu1 And Sheets("feuil2").Cells(lignedebut, 1) = Cu2 And Sheets("feuil2").Cells(lignedebut, 4) = Cu3 And _
    Sheets("feuil2").Cells(lignedebut, 3) = Cu4 And Sheets("feuil2").Cells(lignedebut, 20) = Cu5 And Sheets("feuil2").Cells(lignedebut, 21) = Cu6 And _
    Sheets("feuil2").Cells(lignedebut, 22) = cu7 And Sheets("feuil2").Cells(lignedebut, 19) = Cu8 And Sheets("feuil2").Cells(lignedebut, 9) = Cu9 And _
    Sheets("feuil2").Cells(lignedebut, 11) = Cu10 And Sheets("feuil2").Cells(lignedebut, 10) = Cu11 And Sheets("feuil2").Cells(lignedebut, 16) = Cu12 And _
    Sheets("feuil2").Cells(lignedebut, 17) = Cu13 And Sheets("feuil2").Cells(lignedebut, 5) = Cu14 And Sheets("feuil2").Cells(lignedebut, 7) = Cu15 And _
    Sheets("feuil2").Cells(lignedebut, 34) = Cu16 And Sheets("feuil2").Cells(lignedebut, 8) = Cu17 And Sheets("feuil2").Cells(lignedebut, 33) = Cu18 And _
    Sheets("feuil2").Cells(lignedebut, 6) = Cu19 Then
 
 
  '========================================listview===============================================
       With ListView1
 
                 .ListItems.Add , , lignedebut
                 .FullRowSelect = True
                 .View = lvwReport 'affiche en details
        End With
 
        If Sheets("feuil2").Cells(lignedebut, 2).Value = "chaufferie" Then coul = vbRed Else coul = vbBlue 
 
            ListView1.ListItems(lig).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 1).Value 
           ListView1.ListItems(lig).ListSubItems.Item(1).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 2).Value 
           ListView1.ListItems(lig).ListSubItems.Item(2).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 4).Value 
            ListView1.ListItems(lig).ListSubItems.Item(3).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 5).Value 
           ListView1.ListItems(lig).ListSubItems.Item(4).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 34).Value 'proprio col6"
           ListView1.ListItems(lig).ListSubItems.Item(5).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 20).Value 
           ListView1.ListItems(lig).ListSubItems.Item(6).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 21).Value 
           ListView1.ListItems(lig).ListSubItems.Item(7).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 22).Value & " €" 
           ListView1.ListItems(lig).ListSubItems.Item(8).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 19).Value 
           ListView1.ListItems(lig).ListSubItems.Item(9).ForeColor = coul
 
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 11).Value 
           ListView1.ListItems(lig).ListSubItems.Item(10).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 9).Value 
           ListView1.ListItems(lig).ListSubItems.Item(11).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 10).Value 
           ListView1.ListItems(lig).ListSubItems.Item(12).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 16).Value 
           ListView1.ListItems(lig).ListSubItems.Item(13).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 17).Value 
           ListView1.ListItems(lig).ListSubItems.Item(14).ForeColor = coul
 
       lig = lig + 1 'compteur ligne listview
 
       'If (lig And 1) = 0 Then coul = vbRed Else coul = vbYellow 'detecte le nb si paire en rouge sinon jaune
 
 
     '=====================================listview=========================================================
 
      ' jj = jj + 1
    End If
Next lignedebut
End Sub

le resultat va dans une listview mais à adapter en fonction de tes besoins.

[tony847]

bonjour a tous , bonsoir tony

ci_joint le code que j'ai realise avec l'aide du forum.

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
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
134
135
136
137
138
139
140
141
142
143
 
Private Sub recherche() 'recherche multicritere
Dim lignedebut As Integer
Dim derniereligne As Integer
 
'Dim jj As Long
Dim Cu1$, Cu2$, Cu3$, Cu4$, Cu5$, Cu6$, cu7$, Cu8$, Cu9$, Cu10$, Cu11$, Cu12$, Cu13$, Cu14$, Cu15$, Cu16$, Cu17$, Cu18$, Cu19$
Cu1 = ""
Cu1 = ""
Cu2 = ""
Cu3 = ""
Cu4 = ""
Cu5 = ""
Cu6 = ""
cu7 = ""
Cu8 = ""
Cu9 = ""
Cu10 = ""
Cu11 = ""
Cu12 = ""
Cu13 = ""
Cu14 = ""
Cu15 = ""
Cu16 = ""
Cu17 = ""
Cu18 = ""
Cu19 = ""
 
ListView1.ListItems.Clear ' efface le contenu de la listviews
 
derniereligne = Sheets("feuil2").Range("A4").End(xlDown).Row 'derniere ligne occupee dans colonne A
 
Dim lig As Integer ' compteur ligne listview
 lig = 1
Dim coul
 
coul = vbRed
For lignedebut = 4 To derniereligne 'on test le contenu des combobox
 
     If ComboBox24.Value <> "" Then Cu1 = ComboBox24.Value Else Cu1 = Sheets("feuil2").Cells(lignedebut, 2)
     If ComboBox6.Value <> "" Then Cu2 = ComboBox6.Value Else Cu2 = Sheets("feuil2").Cells(lignedebut, 1)
     If ComboBox5.Value <> "" Then Cu3 = ComboBox5.Value Else Cu3 = Sheets("feuil2").Cells(lignedebut, 4)
     If ComboBox26.Value <> "" Then Cu4 = ComboBox26.Value Else Cu4 = Sheets("feuil2").Cells(lignedebut, 3)
     If ComboBox14.Value <> "" Then Cu5 = ComboBox14.Value Else Cu5 = Sheets("feuil2").Cells(lignedebut, 20)
     If ComboBox15.Value <> "" Then Cu6 = ComboBox15.Value Else Cu6 = Sheets("feuil2").Cells(lignedebut, 21)
     If ComboBox16.Value <> "" Then cu7 = ComboBox16.Value Else cu7 = Sheets("feuil2").Cells(lignedebut, 22)
     If ComboBox17.Value <> "" Then Cu8 = ComboBox17.Value Else Cu8 = Sheets("feuil2").Cells(lignedebut, 19)
     If ComboBox23.Value <> "" Then Cu9 = ComboBox23.Value Else Cu9 = Sheets("feuil2").Cells(lignedebut, 9)
     If ComboBox22.Value <> "" Then Cu10 = ComboBox22.Value Else Cu10 = Sheets("feuil2").Cells(lignedebut, 11)
     If ComboBox19.Value <> "" Then Cu11 = ComboBox19.Value Else Cu11 = Sheets("feuil2").Cells(lignedebut, 10)
     If ComboBox9.Value <> "" Then Cu12 = ComboBox9.Value Else Cu12 = Sheets("feuil2").Cells(lignedebut, 16)
     If ComboBox8.Value <> "" Then Cu13 = ComboBox8.Value Else Cu13 = Sheets("feuil2").Cells(lignedebut, 17)
 
     If ComboBox3.Value <> "" Then Cu14 = ComboBox3.Value Else Cu14 = Sheets("feuil2").Cells(lignedebut, 5)
     If ComboBox27.Value <> "" Then Cu15 = ComboBox27.Value Else Cu15 = Sheets("feuil2").Cells(lignedebut, 7)
     If ComboBox29.Value <> "" Then Cu16 = ComboBox29.Value Else Cu16 = Sheets("feuil2").Cells(lignedebut, 34)
     If ComboBox28.Value <> "" Then Cu17 = ComboBox28.Value Else Cu17 = Sheets("feuil2").Cells(lignedebut, 8)
     If ComboBox30.Value <> "" Then Cu18 = ComboBox30.Value Else Cu18 = Sheets("feuil2").Cells(lignedebut, 33)
     If ComboBox4.Value <> "" Then Cu19 = ComboBox4.Value Else Cu19 = Sheets("feuil2").Cells(lignedebut, 6)
 
 
    'test final avec toute les conditon imbriquee
    'affichage  dans listbox en multicolonne
    If Sheets("feuil2").Cells(lignedebut, 2) = Cu1 And Sheets("feuil2").Cells(lignedebut, 1) = Cu2 And Sheets("feuil2").Cells(lignedebut, 4) = Cu3 And _
    Sheets("feuil2").Cells(lignedebut, 3) = Cu4 And Sheets("feuil2").Cells(lignedebut, 20) = Cu5 And Sheets("feuil2").Cells(lignedebut, 21) = Cu6 And _
    Sheets("feuil2").Cells(lignedebut, 22) = cu7 And Sheets("feuil2").Cells(lignedebut, 19) = Cu8 And Sheets("feuil2").Cells(lignedebut, 9) = Cu9 And _
    Sheets("feuil2").Cells(lignedebut, 11) = Cu10 And Sheets("feuil2").Cells(lignedebut, 10) = Cu11 And Sheets("feuil2").Cells(lignedebut, 16) = Cu12 And _
    Sheets("feuil2").Cells(lignedebut, 17) = Cu13 And Sheets("feuil2").Cells(lignedebut, 5) = Cu14 And Sheets("feuil2").Cells(lignedebut, 7) = Cu15 And _
    Sheets("feuil2").Cells(lignedebut, 34) = Cu16 And Sheets("feuil2").Cells(lignedebut, 8) = Cu17 And Sheets("feuil2").Cells(lignedebut, 33) = Cu18 And _
    Sheets("feuil2").Cells(lignedebut, 6) = Cu19 Then
 
 
  '========================================listview===============================================
       With ListView1
 
                 .ListItems.Add , , lignedebut
                 .FullRowSelect = True
                 .View = lvwReport 'affiche en details
        End With
 
        If Sheets("feuil2").Cells(lignedebut, 2).Value = "chaufferie" Then coul = vbRed Else coul = vbBlue 
 
            ListView1.ListItems(lig).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 1).Value 
           ListView1.ListItems(lig).ListSubItems.Item(1).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 2).Value 
           ListView1.ListItems(lig).ListSubItems.Item(2).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 4).Value 
            ListView1.ListItems(lig).ListSubItems.Item(3).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 5).Value 
           ListView1.ListItems(lig).ListSubItems.Item(4).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 34).Value 'proprio col6"
           ListView1.ListItems(lig).ListSubItems.Item(5).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 20).Value 
           ListView1.ListItems(lig).ListSubItems.Item(6).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 21).Value 
           ListView1.ListItems(lig).ListSubItems.Item(7).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 22).Value & " €" 
           ListView1.ListItems(lig).ListSubItems.Item(8).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 19).Value 
           ListView1.ListItems(lig).ListSubItems.Item(9).ForeColor = coul
 
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 11).Value 
           ListView1.ListItems(lig).ListSubItems.Item(10).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 9).Value 
           ListView1.ListItems(lig).ListSubItems.Item(11).ForeColor = coul
 
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 10).Value 
           ListView1.ListItems(lig).ListSubItems.Item(12).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 16).Value 
           ListView1.ListItems(lig).ListSubItems.Item(13).ForeColor = coul
 
           ListView1.ListItems(lig).ListSubItems.Add , , Sheets("feuil2").Cells(lignedebut, 17).Value 
           ListView1.ListItems(lig).ListSubItems.Item(14).ForeColor = coul
 
       lig = lig + 1 'compteur ligne listview
 
       'If (lig And 1) = 0 Then coul = vbRed Else coul = vbYellow 'detecte le nb si paire en rouge sinon jaune
 
 
     '=====================================listview=========================================================
 
      ' jj = jj + 1
    End If
Next lignedebut
End Sub

le resultat va dans une listview mais à adapter en fonction de tes besoins.

merci,

je voulais te demander voilà ,

j'ai réussi à afficher dans le combox cascade les valeurs que je voulais,
maintenant plus dur ,
j'aimerai que la valeur qui se trouve dans le combox2 soit comparer à la cellule 2 de la feuille 2 par exemple et copié les lignes déterminer dans une autre feuille.

Voilà mon souci du moment si tes inspirés j'arrêterai peut-être de tremspiré!

[tony847]

j'ai beau adapté le code mais ça ne marche pas!

[tony847]

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
Option Explicit
 
Private Sub B_Quitter_Click()
    Unload UserForm4
End Sub
 
Private Sub Localité_Change()
Rempliste
End Sub
 
Private Sub UserForm_Initialize()
    Init
End Sub
 
Private Sub Valider_Click()
 
           Dim c As Variant, Valeur
Valeur = Me.Unité
Worksheets("Feuil3").Range("O3").Select
With Worksheets("Mod feuille").Range("O3:a" & Range("P65536").End(xlUp).Row)
    Set c = .Find(Valeur, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
         c.EntireRow.Copy Worksheets("Feuil3").Range("A" & Range("A65536").End(xlUp).Row)
    End If
End With
 
End Sub

voici mon code

[tony847]

Et les détails que je t'ai demandés ?

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
Option Explicit
Dim i As Integer
Dim ValTable As String
Sub Lanc_Appli()
    'affiche la boite
    UserForm4.Show
End Sub
Sub Init()
    'initialisation de la boite
    'Ajoute des valeurs de la colonne "A" dans la liste 1
    i = 1
    'Tant qu'on trouve une valeur
    Do While Sheets("Mod feuille").Range("N3").Offset(i, 0) <> ""
        UserForm4.Localité.AddItem Sheets("Mod feuille").Range("N3").Offset(i, 0)
        i = i + 1
    Loop
End Sub
 
Sub Rempliste()
    'efface les données de la liste2
    UserForm4.Unité.Clear
    'Récupération de la valeur de la liste1
    ValTable = UserForm4.Localité
    i = 1
    'Boucle "Do While-Loop" pour chaque valeur de la colonne "B"
    Do While Sheets("Mod feuille").Range("O3").Offset(i, 0) <> ""
        'si la valeur de la colonne "B" est identique à la valeur de la liste 1,
        'on ajoute sa valeur correspondante de la colonne "C" dans la liste 2.
        If Sheets("Mod feuille").Range("O3").Offset(i, 0) = ValTable Then
            UserForm4.Unité.AddItem Sheets("Mod feuille").Range("P3").Offset(i, 0)
 
     'si la valeur de la colonne "C" est identique à la valeur de la liste 2,
        'on ajoute sa valeur correspondante de la colonne "D" dans la liste 3.
            UserForm4.Périodicité.AddItem Sheets("Mod feuille").Range("Q3").Offset(i, 0)
 
 
        End If
    i = i + 1
    Loop
 
End Sub

ce code est celui qui se trouve dans le module

Aprés le détail du code?

[tony847]

bonjour,

je remet le code qui m'affiche dans les combo les donnée que j'ai sélectionné.
Mais je veux supprimer les doublons.
Avez vous un code qui fonctionne avec ce 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
Dim ValTable As String
  Dim i As Integer
    UserForm4.ComBox2.Clear
    'Récupération de la valeur de la liste1
    ValTable = UserForm4.ComBox1
    i = 1
    'Boucle "Do While-Loop" pour chaque valeur de la colonne "B"
    For i = 2 To 4000
 
        'si la valeur de la colonne "B" est identique à la valeur de la liste 1,
        'on ajoute sa valeur correspondante de la colonne "C" dans la liste 2.
        If Sheets("Feuil4").Range("B2").Offset(i, 0) = ValTable Then
            UserForm4.ComBox2.AddItem Sheets("Feuil4").Range("C2").Offset(i, 0)
         'si la valeur de la colonne "C" est identique à la valeur de la liste 2,
        'on ajoute sa valeur correspondante de la colonne "Q" dans la liste 3.
            UserForm4.ComBox3.AddItem Sheets("Feuil4").Range("Q2").Offset(i, 0)
        End If
    i = i + 1
   Next i
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub UserForm_Initialize()
 
    Dim i As Integer
       'initialisation de la boite
    'Ajoute des valeurs de la colonne "B" dans la liste 1
    i = 1
    'Tant qu'on trouve une valeur
    Do While Sheets("Feuil4").Range("A2").Offset(i, 0) <> ""
        UserForm4.ComBox1.AddItem Sheets("Feuil4").Range("B2").Offset(i, 0)
          UserForm4.ComBox2 = Range("B" & i)
        i = i + 1
    Loop
End Sub

[tony847]

As-tu jeté un oeil ? Bien sûr, il faut comprendre...
Si tu ne comprends pas demande une explication mais, "là", tu as la réponse et je n'en connais pas de plus simple.

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
Option Explicit
Private Sub B_Quitter_Click()
    Unload UserForm4
End Sub
 
Private Sub UserForm4_Initialize()
    Dim i As Integer
       'initialisation de la boite
    'Ajoute des valeurs de la colonne "B" dans la liste 1
    i = 1
    'Tant qu'on trouve une valeur
    Do While Sheets("Feuil4").Range("A2").Offset(i, 0) <> ""
        Me.ComBox1.AddItem Sheets("Feuil4").Range("B2").Offset(i, 0)
          Me.ComBox2 = Range("B" & i)
        i = i + 1
    Loop
Dim adres As String, j As Long
    'remplissage de combobox1 avec plage complète
    adres = Sheets("Feuil4").Range("B1:B" & Range("B65536").End(xlUp).Row).Address
    ComboBox1.RowSource = adres
    'remplassage de ComboBox2 selon combobox1 sans doublon
    For j = 0 To ComboBox1.ListCount - 1
        Waitt = True
        Me.ComboBox2 = ComboBox1.List(i, 0)
        'Remplissage excluant les doublons
        If Me.ComboBox2.ListIndex = -1 Then _
            Me.ComboBox2.AddItem ComboBox1.List(i, 0)
    Next j
End Sub
 
Private Sub ComBox1_Change()
Dim adres As String
  Dim i As Integer
    Me.ComBox2.Clear
    'Récupération de la valeur de la liste1
    adres = Me.ComBox1
    i = 1
    'Boucle "Do While-Loop" pour chaque valeur de la colonne "B"
    Do While Sheets("Feuil4").Range("B2").Offset(i, 0) <> ""
        'si la valeur de la colonne "B" est identique à la valeur de la liste 1,
        'on ajoute sa valeur correspondante de la colonne "C" dans la liste 2.
        If Sheets("Feuil4").Range("B2").Offset(i, 0) = adres Then
            Me.ComBox2.AddItem Sheets("Feuil4").Range("C2").Offset(i, 0)
         'si la valeur de la colonne "C" est identique à la valeur de la liste 2,
        'on ajoute sa valeur correspondante de la colonne "Q" dans la liste 3.
            Me.ComBox3.AddItem Sheets("Feuil4").Range("Q2").Offset(i, 0)
        End If
    i = i + 1
  Loop
End Sub

ça ne sélectionne plus de donnée dans les combo?

[tony847]

voici un essai

[Pierre Fauconnier]

voici un essai

Peux-tu repréciser ce que tu souhaites en combo1, combo2 et combo3?

Vu l'abondance des messages, je commence à m'y perdre...

Quoi qu'il en soit, j'aborderais le problème autrement, mais j'ai besoin que tu répondes à ma question.

[tony847]

en combo1 je veu la colonne B en combo2 colonne C en combo3 colonne Q

[Pierre Fauconnier]

Voila comment je procéderais...

Au lieu de vouloir extraire les doublons de la liste, je préfère ne pas les y mettre. Pour cela, c'est à la création des combobox que je vérifie pour ne pas ajouter des valeurs déjà présentes.

L'utilisation d'un objet Collection va permettre cela.

Je crée donc une procédure dans un module standard. Je pense que le code parle de lui-même. On passe à la procédure la collection et la valeur que l'on souhaite y ajouter, on itère les éléments de la collection avec un drapeau booléen et si le drapeau a la valeur False, l'item n'est pas présent et il est ajouté.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub AjouterItem(ByRef oCollection As Collection, ByVal strItem As String)
    Dim oObjet As Object
    Dim ValeurPresente As Boolean
    Dim i As Long
 
    For i = 1 To oCollection.Count
        If oCollection.Item(i) = strItem Then
            ValeurPresente = True
            Exit Sub
        End If
    Next i
    If Not ValeurPresente Then oCollection.Add strItem
End Sub

Après itération sur toutes les cellules de la colonne, on itère sur la collection pour ajouter les lignes à ComBox1, dans l'évènement d'initialisation du userform

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub UserForm_Initialize()
    Dim Cellule As Range
    Dim oCollection As New Collection
    Dim i As Long
 
    For Each Cellule In Feuil4.Range("b2:b" & Feuil4.Range("b" & Rows.Count).End(xlUp).Row)
        AjouterItem oCollection, Cellule.Value
    Next Cellule
 
    For i = 1 To oCollection.Count
        ComBox1.AddItem oCollection.Item(i)
    Next i
End Sub

On opère de la même façon pour remplir le ComBox2 sur l'évènement Change de ComBox1, en testant la correspondance entre la valeur de ComBox1 et la valeur de la cellule B...

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 ComBox1_Change()
    Dim Cellule As Range
    Dim oCollection As New Collection
    Dim i As Long
 
    ComBox2.Clear
 
    ' Itération sur chaque cellule de C, vérification de la valeur de B
    '  et appel de la procédure d'ajout
    For Each Cellule In Feuil4.Range("c2:c" & Feuil4.Range("c" & Rows.Count).End(xlUp).Row)
        If Cellule(1, 0).Value = ComBox1.Value Then AjouterItem oCollection, Cellule.Value
    Next Cellule
 
    For i = 1 To oCollection.Count
        ComBox2.AddItem oCollection.Item(i)
    Next i
End Sub

Ok?