Combobox filtrée

tumble - 1 août 2012 à 09:21
 tumble - 1 août 2012 à 14:27
Bonjour à tous,

j'apprends VBA petit à petit grâce à l'expérience de beaucoup d'entre vous et à leur réponse sur le site.
ce coup-ci je me jète à l'eau pour poser ma propre questions !!!
voilà, j'ai un tableau sous excel 2010 que j'alimente par un Userform2 (ci-dessous les formules)
ce tableau est constitué de 21 colonnes dont la première est "RS" (nom) que je récupère dans une combobox3 dans
mon Userform1. Dans ma combobox4 du Userform1 (voir une listbox si il le faut) je voudrais récupérer (en fonction
du choix fait dans ma combobox3) les valeurs correspondantes des colonnes D,G,J et L
exemple:
Colonne RS A B C D E F G H I J K L
TOTO 1 2 3 4 5 6 7 8 9 10 11 12
TITI 12 11 10 9 8 7 6 5 4 3 2 1
TUTU " " " " " " " " " " " "
si je sélectionne TITI dans ma combobox3, je retrouve 9,6,3 et 1 dans ma combobox4

merci pour un p'tit coup de main !!!

"formule pour mon Userform2" (création fiches clients)

Private Sub CommandButton1_Click()
If TextBox1.Value = "" Then
MsgBox ("Il faut saisir une raison sociale !")
TextBox1.SetFocus
Exit Sub 'interrompt la macro de validation, le userform reste affiché en l'état pour correction
End If


If TextBox2.Value = "" Then
MsgBox ("Il faut saisir un N°compte SAP !")
TextBox2.SetFocus
Exit Sub

End If


If TextBox3.Value = "" Then
MsgBox ("Il faut saisir une adresse postale !")
TextBox3.SetFocus
Exit Sub

End If

If TextBox5.Value = "" Then
MsgBox ("Il faut saisir un code postal !")
TextBox5.SetFocus
Exit Sub

End If

If TextBox4.Value = "" Then
MsgBox ("Il faut saisir une adresse de livraison !")
TextBox4.SetFocus
Exit Sub

End If

If TextBox6.Value = "" Then
MsgBox ("Il faut saisir un code postal !")
TextBox6.SetFocus
Exit Sub

End If

If TextBox7.Value = "" Then
MsgBox ("Il faut renseigner au moins contact 1 !")
TextBox7.SetFocus
Exit Sub

End If

If TextBox12.Value = "" Then
MsgBox ("Il faut saisir le téléphone du contact 1 !")
TextBox12.SetFocus
Exit Sub

End If

If TextBox17.Value = "" Then
MsgBox ("Il faut saisir l'adresse mail du contact 1 !")
TextBox17.SetFocus
Exit Sub

End If

Dim no_ligne As Integer, RS As String



'no_ligne = N° de ligne de la dernière cellule non vide de la colonne +1
no_ligne = Range("A65536").End(xlUp).Row + 1

'Insertion des valeurs sur la feuille
Cells(no_ligne, 1) = TextBox1.Value
Cells(no_ligne, 2) = TextBox2.Value
Cells(no_ligne, 3) = TextBox3.Value
Cells(no_ligne, 4) = TextBox5.Value
Cells(no_ligne, 5) = TextBox4.Value
Cells(no_ligne, 6) = TextBox6.Value
Cells(no_ligne, 7) = TextBox7.Value
Cells(no_ligne, 8) = TextBox12.Value
Cells(no_ligne, 9) = TextBox17.Value
Cells(no_ligne, 10) = TextBox8.Value
Cells(no_ligne, 11) = TextBox13.Value
Cells(no_ligne, 12) = TextBox18.Value
Cells(no_ligne, 13) = TextBox9.Value
Cells(no_ligne, 14) = TextBox14.Value
Cells(no_ligne, 15) = TextBox19.Value
Cells(no_ligne, 16) = TextBox10.Value
Cells(no_ligne, 17) = TextBox15.Value
Cells(no_ligne, 18) = TextBox20.Value
Cells(no_ligne, 19) = TextBox11.Value
Cells(no_ligne, 20) = TextBox16.Value
Cells(no_ligne, 21) = TextBox21.Value
'Après insertion, on remet les valeurs initiales

TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
TextBox11.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox14.Value = ""
TextBox15.Value = ""
TextBox16.Value = ""
TextBox17.Value = ""
TextBox18.Value = ""
TextBox19.Value = ""
TextBox20.Value = ""
TextBox21.Value = ""


End Sub

[color=]"formules pour ma combobox3 de mon Userform1"/color(exploitation fiches clients)

Private Sub UserForm_Initialize()
Set f = Sheets("feuil1")
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A6500].End(xlUp))
mondico(c.Value) = c.Value
Next c
temp = mondico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox3.List = temp
End Sub
Private Sub ComboBox3_Change()
Set f = Sheets("feuil1")
ComboBox4.Clear

Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A6500].End(xlUp))
If c Me.ComboBox3 Then mondico(c.Offset(0, 4).Value) c.Offset(0, 4).Value
Next c
If mondico.Count > 0 Then
temp = mondico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.ComboBox4.List = temp
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

4 réponses

NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
1 août 2012 à 13:42
Bonjour,

Si c'est du VBA, il faut classer dans VBA, pas VB6, je déplace le sujet.

Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : ).

Concernant ton problème, comme la mise en forme de ton exemple a foiré, il est pas facile de répondre, mais je pense qu'une boucle Do/Loop pour rechercher la ligne peut être une bonne base.

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, celui-ci pour bien poser votre question ou encore celui-ci pour les PFE et autres exercices.[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : ).[*]En VB.NET pensez à activer Option Explicit et Option Strict (propriété du projet) et à retirer l'import automatique de l'espace de nom Microsoft.VisualBasic (onglet Références dans les propriétés du projet).[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés/list
---
Mon site
0
Ok, j'ai pas encore tous les réflexs, c'était mon premier message sur le site, est ce mieux comme ça pour la
mise en forme du code ?

"formule pour mon Userform2" (création fiches clients)

Private Sub CommandButton1_Click() 
If TextBox1.Value = "" Then 
MsgBox ("Il faut saisir une raison sociale !") 
TextBox1.SetFocus 
Exit Sub 'interrompt la macro de validation, le userform reste affiché en l'état pour correction
 End If 


If TextBox2.Value = "" Then 
MsgBox ("Il faut saisir un N°compte SAP !") 
TextBox2.SetFocus 
Exit Sub 

End If 


If TextBox3.Value = "" Then 
MsgBox ("Il faut saisir une adresse postale !") 
TextBox3.SetFocus 
Exit Sub 

End If 

If TextBox5.Value = "" Then 
MsgBox ("Il faut saisir un code postal !") 
TextBox5.SetFocus 
Exit Sub 

End If 

If TextBox4.Value = "" Then 
MsgBox ("Il faut saisir une adresse de livraison !") 
TextBox4.SetFocus 
Exit Sub 

End If 

If TextBox6.Value = "" Then 
MsgBox ("Il faut saisir un code postal !") 
TextBox6.SetFocus 
Exit Sub 

End If 

If TextBox7.Value = "" Then 
MsgBox ("Il faut renseigner au moins contact 1 !") 
TextBox7.SetFocus 
Exit Sub 

End If 

If TextBox12.Value = "" Then 
MsgBox ("Il faut saisir le téléphone du contact 1 !") 
TextBox12.SetFocus 
Exit Sub 

End If 

If TextBox17.Value = "" Then 
MsgBox ("Il faut saisir l'adresse mail du contact 1 !") 
TextBox17.SetFocus 
Exit Sub 

End If 

Dim no_ligne As Integer, RS As String 



'no_ligne = N° de ligne de la dernière cellule non vide de la colonne +1 
no_ligne = Range("A65536").End(xlUp).Row + 1 

'Insertion des valeurs sur la feuille 
Cells(no_ligne, 1) = TextBox1.Value 
Cells(no_ligne, 2) = TextBox2.Value 
Cells(no_ligne, 3) = TextBox3.Value 
Cells(no_ligne, 4) = TextBox5.Value 
Cells(no_ligne, 5) = TextBox4.Value 
Cells(no_ligne, 6) = TextBox6.Value 
Cells(no_ligne, 7) = TextBox7.Value 
Cells(no_ligne, 8) = TextBox12.Value 
Cells(no_ligne, 9) = TextBox17.Value 
Cells(no_ligne, 10) = TextBox8.Value 
Cells(no_ligne, 11) = TextBox13.Value 
Cells(no_ligne, 12) = TextBox18.Value 
Cells(no_ligne, 13) = TextBox9.Value 
Cells(no_ligne, 14) = TextBox14.Value 
Cells(no_ligne, 15) = TextBox19.Value 
Cells(no_ligne, 16) = TextBox10.Value 
Cells(no_ligne, 17) = TextBox15.Value 
Cells(no_ligne, 18) = TextBox20.Value 
Cells(no_ligne, 19) = TextBox11.Value 
Cells(no_ligne, 20) = TextBox16.Value 
Cells(no_ligne, 21) = TextBox21.Value 
'Après insertion, on remet les valeurs initiales 

TextBox1.Value = "" 
TextBox2.Value = "" 
TextBox3.Value = "" 
TextBox4.Value = "" 
TextBox5.Value = "" 
TextBox6.Value = "" 
TextBox7.Value = "" 
TextBox8.Value = "" 
TextBox9.Value = "" 
TextBox10.Value = "" 
TextBox11.Value = "" 
TextBox12.Value = "" 
TextBox13.Value = "" 
TextBox14.Value = "" 
TextBox15.Value = "" 
TextBox16.Value = "" 
TextBox17.Value = "" 
TextBox18.Value = "" 
TextBox19.Value = "" 
TextBox20.Value = "" 
TextBox21.Value = "" 


End Sub 


[color=]"formules pour ma combobox3 de mon Userform1"/color(exploitation fiches clients)

Private Sub UserForm_Initialize() 
Set f = Sheets("feuil1") 
Set mondico = CreateObject("Scripting.Dictionary") 
For Each c In Range(f.[A2], f.[A6500].End(xlUp)) 
mondico(c.Value) = c.Value 
Next c 
temp = mondico.items 
Call Tri(temp, LBound(temp), UBound(temp)) 
Me.ComboBox3.List = temp 
End Sub 
Private Sub ComboBox3_Change() 
Set f = Sheets("feuil1") 
ComboBox4.Clear 

Set mondico = CreateObject("Scripting.Dictionary") 
For Each c In Range(f.[A2], f.[A6500].End(xlUp)) 
If c Me.ComboBox3 Then mondico(c.Offset(0, 4).Value) c.Offset(0, 4).Value 
Next c 
If mondico.Count > 0 Then 
temp = mondico.items 
Call Tri(temp, LBound(temp), UBound(temp)) 
Me.ComboBox4.List = temp 
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
0
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
1 août 2012 à 14:23
Bonjour,

Pas la peine d'ouvrir plusieurs fois la discussion.

"Réponse acceptée" = "Problème résolu"

Avec l'Indentation, c'est toujours mieux.

Sinon, as-tu regardé la boucle Do/Loop pour ta recherche ?

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, celui-ci pour bien poser votre question ou encore celui-ci pour les PFE et autres exercices.[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : ).[*]En VB.NET pensez à activer Option Explicit et Option Strict (propriété du projet) et à retirer l'import automatique de l'espace de nom Microsoft.VisualBasic (onglet Références dans les propriétés du projet).[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés/list
---
Mon site
0
Non, je ne connais ce code "boucle do/Loop" et où le mettre, je vais voir dans l'aide VBA si il en parle
0
Rejoignez-nous