[vba]faire correspondre 2 combobox
Résolu/Fermé
oxydedefer
-
13 févr. 2012 à 19:32
cousinhub29 Messages postés 881 Date d'inscription mardi 10 août 2010 Statut Membre Dernière intervention 16 avril 2024 - 13 févr. 2012 à 22:53
cousinhub29 Messages postés 881 Date d'inscription mardi 10 août 2010 Statut Membre Dernière intervention 16 avril 2024 - 13 févr. 2012 à 22:53
A voir également:
- [vba]faire correspondre 2 combobox
- 2 comptes whatsapp - Guide
- 2 ecran pc - Guide
- Word numéro de page 1/2 - Guide
- Vba attendre 1 seconde ✓ - Forum VB / VBA
- Ads.fiancetrack(2).dll - Forum Windows 10
6 réponses
cousinhub29
Messages postés
881
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
16 avril 2024
333
13 févr. 2012 à 20:59
13 févr. 2012 à 20:59
Bonsoir,
Un petit fichier exemple :
https://www.cjoint.com/?BBnu6OppwyV
Si plusieurs occurrences trouvées, elles sont toutes supprimées
Bonne soirée
Un petit fichier exemple :
https://www.cjoint.com/?BBnu6OppwyV
Si plusieurs occurrences trouvées, elles sont toutes supprimées
Bonne soirée
cousinhub29
Messages postés
881
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
16 avril 2024
333
13 févr. 2012 à 21:51
13 févr. 2012 à 21:51
Re-,
Tu as bien recopié le module1, qui contient la procédure de tri?
Tu as bien recopié le module1, qui contient la procédure de tri?
Merci pour ta réponse :D sa m 'aide déjà beaucoup ,mais lorsque je l 'inscrit dans mon code il bloque en erreur de compilation lors de l appel de la fonction call tri :s
Résolution pour ma part grâce a Cousinhub29 (merci a toi ;) , je post le code dans le futur quelqu'un en a besoin :
Dim Cel As Range, C As Range
Dim LesNoms As Object
Dim PremNom As String
Dim Tmp
Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
If Me.ComboBox1 <> "" Then
For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Me.ComboBox1 = Cel.Value Then
Me.ComboBox2.AddItem Cel.Offset(, 1).Value
End If
Next Cel
End If
End Sub
Private Sub CommandButton1_Click()
If Me.ComboBox1 <> "" And Me.ComboBox2 <> "" Then
rep = MsgBox("Confirmez-vous la suppression?", vbYesNo, "Suppression du Client")
If rep = vbNo Then Exit Sub
With Plg
supp:
Set C = .Find(Me.ComboBox1, LookIn:=xlValues)
If Not C Is Nothing Then
PremNom = C.Address
Do
If C.Offset(, 1).Value = Me.ComboBox2 Then
C.EntireRow.Delete
GoTo supp
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> PremNom
End If
End With
Set Plg = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
LesNoms.RemoveAll
For Each Cel In Plg
LesNoms(Cel.Value) = Cel.Value
Next Cel
Tmp = LesNoms.Items
Call tri(Tmp, LBound(Tmp), UBound(Tmp))
Me.ComboBox2.Clear
Me.ComboBox1.List = Tmp
Me.ComboBox1 = ""
End If
'Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Set LesNoms = CreateObject("Scripting.Dictionary")
Set Plg = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each Cel In Plg
LesNoms(Cel.Value) = Cel.Value
Next Cel
Tmp = LesNoms.Items
Call tri(Tmp, LBound(Tmp), UBound(Tmp))
Me.ComboBox1.List = Tmp
End Sub
----------------------------------------------------------
et le module du tri :
Public Plg As Range
Sub essai()
UserForm1.Show
End Sub
Sub tri(a, gauc, droi) ' Quick sort de JBoisgontier
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
Dim Cel As Range, C As Range
Dim LesNoms As Object
Dim PremNom As String
Dim Tmp
Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
If Me.ComboBox1 <> "" Then
For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Me.ComboBox1 = Cel.Value Then
Me.ComboBox2.AddItem Cel.Offset(, 1).Value
End If
Next Cel
End If
End Sub
Private Sub CommandButton1_Click()
If Me.ComboBox1 <> "" And Me.ComboBox2 <> "" Then
rep = MsgBox("Confirmez-vous la suppression?", vbYesNo, "Suppression du Client")
If rep = vbNo Then Exit Sub
With Plg
supp:
Set C = .Find(Me.ComboBox1, LookIn:=xlValues)
If Not C Is Nothing Then
PremNom = C.Address
Do
If C.Offset(, 1).Value = Me.ComboBox2 Then
C.EntireRow.Delete
GoTo supp
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> PremNom
End If
End With
Set Plg = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
LesNoms.RemoveAll
For Each Cel In Plg
LesNoms(Cel.Value) = Cel.Value
Next Cel
Tmp = LesNoms.Items
Call tri(Tmp, LBound(Tmp), UBound(Tmp))
Me.ComboBox2.Clear
Me.ComboBox1.List = Tmp
Me.ComboBox1 = ""
End If
'Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Set LesNoms = CreateObject("Scripting.Dictionary")
Set Plg = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each Cel In Plg
LesNoms(Cel.Value) = Cel.Value
Next Cel
Tmp = LesNoms.Items
Call tri(Tmp, LBound(Tmp), UBound(Tmp))
Me.ComboBox1.List = Tmp
End Sub
----------------------------------------------------------
et le module du tri :
Public Plg As Range
Sub essai()
UserForm1.Show
End Sub
Sub tri(a, gauc, droi) ' Quick sort de JBoisgontier
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cousinhub29
Messages postés
881
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
16 avril 2024
333
13 févr. 2012 à 22:53
13 févr. 2012 à 22:53
Re-,
Effectivement, comme on supprime la plage de cellules nommée "Plg", on obtient cette erreur....
On peut passer outre en ajoutant cette ligne de code, qui vérifie si la cellule A2 n'est pas vide....
Peut-être....
Effectivement, comme on supprime la plage de cellules nommée "Plg", on obtient cette erreur....
On peut passer outre en ajoutant cette ligne de code, qui vérifie si la cellule A2 n'est pas vide....
......
......
With Plg
supp:
If Range("A2").Value = "" Then End
Set C = .Find(Me.ComboBox1, LookIn:=xlValues)
......
......
Peut-être....
