Excel VBA 2 COMBOBOX dont la seconde reste avec doublon

Le 26/02/2019 à 16:45

Bonjour,

Voilà bien des mois de recherche mais sans succès, alors je me suis décidée à poser la question ici sur ce forum en espérant qu'un ou une experte pourra m'aider.

J'ai débuté en VBA afin d'optimiser une petite base de données pour saisir différents éléments de suivi de titres et leurs gestions.

J'ai réussi à créer un formulaire simple avec 2 combobox en cascade l'une dépendante de l'autre. Mon souci c'est que je n'ai pas réussi à trouver le bon code pour que la seconde combobox soit elle aussi sans doublons.

Je m'explique un peu plus:

Combobox1 = une liste de titres (celle ci pas de souci elle est bien sans doublons) colonne A dans mon excel

Combobox2 = une entreprise (celle ci parfois j'ai Entreprise A, puis à nouveau Entreprise A, mais le doublon est tout simplement relatif à une autre ligne ce sont dans les textboxs que les informations sont changeantes)

Après avoir fais choix dans les combobox, les données s'inscrivent dans des TextBox. J'ai réussi à placer dans mon formulaire (USERFORM) des boutons "précédents", et "suivants" pour naviguer les enregistrements une fois que j'ai mon titre de sélectionné et l'entreprise qui l'a en gestion.

Tous les codes différents que j'ai tenté d'adapter ne fonctionne pas. De plus j'ai aussi un bouton ajouter et modifier, si bien que si je modifie déjà le début de mes codes VBA, tout le reste ressort en bug. Je ne m'en sors absolument pas. Etant donné que je suis vraiment dans les prémices, si une bonne âme voulait bien me donner un coup de pouce mais le plus simple possible!!

Pourtant ma demande est simple, je cherche un bout de code soit à rajouter, soit juste adapter avec déjà ce que j'ai pour que je puisse avoir en Combobox2 une fois l'entreprise (même si pour le même titre je l'a retrouverai) Pour naviguer d'un enregistrement à un autre, je ne réutilise pas de combobox, mais uniquement mes boutons précédents et suivants.

Je vous remercie pour vos retours et votre aide par avance.

[u]Voici le code de mon formulaire:

[/u]Option Explicit

Dim Ws As Worksheet

Dim NbLignes As Integer

Dim TextBox As Integer

Private Sub UserForm_Initialize()

Dim j As Long 'déclare la variable J

Dim i As Integer

Set Ws = Sheets("Base")

NbLignes = Ws.Range("A65536").End(xlUp).Row

With Me.ComboBox2

.ColumnCount = 2

.ColumnWidths = "-1;0"

End With

InitCombo1

Sub InitCombo1()

Dim j As Long

Dim Mondico As Object

Set Mondico = CreateObject("Scripting.dictionary")

For j = 2 To NbLignes

Mondico(Ws.Range("A" & j).Value) = ""

Next j

With Me.ComboBox1

.Clear

If Mondico.Count > 0 Then

.List = Application.Transpose(Mondico.keys)

End If

End With

End Sub

Private Sub ComboBox1_Change()

Dim j As Long

Nettoyage

Me.ComboBox2.Clear

If Me.ComboBox1.ListIndex = -1 Then Exit Sub

With Me.ComboBox2

For j = 2 To NbLignes

If Ws.Range("A" & j) = Me.ComboBox1 Then

.AddItem Ws.Range("B" & j)

.List(.ListCount - 1, 1) = j

End If

Next j

End With

End Sub

Private Sub ComboBox2_Change()

Dim Ligne As Long

Dim i As Integer

Nettoyage

If Me.ComboBox2.ListIndex = -1 Then Exit Sub

Ligne = Me.ComboBox2.List(Me.ComboBox2.ListIndex, 1)

For i = 1 To 15

Me.Controls("TextBox" & i) = Ws.cells(Ligne, i).Value

Next i

End Sub

Sub Nettoyage()

Dim i As Integer

For i = 1 To 15

Me.Controls("TextBox" & i) = ""

Next i

End Sub

'Pour le bouton Modifier

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

Dim Ligne As Long

Dim i As Integer

Dim Ctrl As Control

If Me.ComboBox1.ListIndex = -1 Then Exit Sub

Ligne = Me.ComboBox2.List(Me.ComboBox2.ListIndex, 1)

For i = 1 To 15

If Me.Controls("TextBox" & i).Visible = True Then

Ws.cells(Ligne, i) = Me.Controls("TextBox" & i).Value

End If

Next i

MsgBox ("Modification, Complement enregistrés") .

End If

Application.ScreenUpdating = True

End Sub

Private Sub CommandButton4_Click()

Application.ScreenUpdating = False

Dim Ligne As Integer

Dim i As Integer

If MsgBox(" Ajout ?"), vbYesNo, "Demande de confirmation") = vbYes Then 'condition : si oui au message

Ligne = Ws.Range("a65536").End(xlUp).Row + 1 'Permet de se positionner sur la dernière ligne de tableau NON VIDE

For i = 1 To 15

Ws.cells(Ligne, i) = Me.Controls("TextBox" & i).Value

Next i

End If

' Affiche une boîte de message

MsgBox ("Nouvelle saisie enregistrée")

Unload Me ' Vide et ferme l'Userform ( formulaire)

UserForm1.Show vbModeless 'Affiche le formulaire

Application.ScreenUpdating = True

End Sub

Private Sub CommandButton9_Click()

If ComboBox2.ListIndex < (ComboBox2.ListCount - 1) Then

ComboBox2.ListIndex = ComboBox2.ListIndex + 1

Else

MsgBox "Vous avez atteint la fin des enregistrements."

End If

End Sub

Private Sub CommandButton10_Click()

If ComboBox2.ListIndex > 0 Then

ComboBox2.ListIndex = ComboBox2.ListIndex - 1

Else

MsgBox "Il n'existe pas d'enregistrement précédent."

End If

End Sub

Le 26/02/2019 à 18:48

Bonjour et bienvenue sur le forum

Tu devrais joindre ton fichier complet, quitte à modifier les données éventuellement sensibles...

Bye !

Le 26/02/2019 à 19:00

Bonsoir,

Essayer ce début de code :

Option Explicit

Dim Ws As Worksheet
Dim NbLignes As Integer
Dim Titres As Object, Entreprises As Object

Private Sub UserForm_Initialize()
    Dim j As Long 'd?clare la variable J
    Dim i As Integer

    Set Ws = Sheets("Base")
    NbLignes = Ws.Range("A65536").End(xlUp).Row

    With Me.ComboBox2
        .ColumnCount = 2
        .ColumnWidths = "-1;0"
    End With

    InitCombo1
End Sub

Sub InitCombo1()
    Dim j As Long
    Dim titre As String, entreprise As String

    Set Titres = CreateObject("Scripting.dictionary")
    For j = 2 To NbLignes
        titre = Ws.Range("A" & j).Value
        entreprise = Ws.Range("B" & j).Value
        If Not Titres.exists(titre) Then Set Titres(titre) = CreateObject("Scripting.dictionary")
        Set Entreprises = Titres(titre)
        If Not Entreprises.exists(entreprise) Then Entreprises(entreprise) = j
        Set Titres(titre) = Entreprises
    Next j
    With Me.ComboBox1
        .Clear
        If Titres.Count > 0 Then .List = Application.Transpose(Titres.keys)
    End With
End Sub

Private Sub ComboBox1_Change()
    Dim j As Long
    Dim entreprise As Variant
    If Me.ComboBox1.ListIndex = -1 Then Exit Sub

    Nettoyage
    Set Entreprises = Titres(Me.ComboBox1.Value)
    With Me.ComboBox2
        .Clear
        For Each entreprise In Entreprises.keys
            .AddItem entreprise
            .List(.ListCount - 1, 1) = Entreprises(entreprise)
        Next entreprise
    End With

End Sub
Le 27/02/2019 à 10:52

Bonjour,

Je vous remercie infiniment pour votre réponse, et votre début de code fonctionne à merveille. Je n'ai plus du tout de doublons que ce soit dans la combobox1 mais aussi dans la seconde (combobox2).

Par contre je ne voudrais pas user à nouveau de vos compétences, mais à présent j'obtiens dans mes textboxs informations du premier enregistrement qui va concerné le titre et l'entreprise, exemple:

Dans mon tableau Excel:

Titre (Colonne A- Entreprise (colonne B - référencé (colonneC)

Gribouille - GESTOR - a/256

Gribouille - GESTOR - b/698

Gribouille - TARTEMPION - c/452

Avec le code que vous m'avez communiqué quand je fais dérouler mon Choix et que je veux visionner "Gribouille" ensuite dans la seconde combobox, je fais choix de l'entreprise (comme les listes peuvent être en grands nombres, je ne voulais pas de doublons dans la seconde combobox, c'était mon problème initial); Donc avec le nouveau code qui réponds à la suppression des doublons, dés que j'ai choisi mon entreprise, je n'ai que le résultat dans les TextBox de la première ligne de ma base soit : "a/256

Ce qui est fort normal puisque le code permet de filtrer. J'ai conçu mon formulaire pour qu'avec mon bouton suivant je puisse d'un clic dessus faire changer juste mes textbox puisque dans mes listes j'ai fais le bon choix, mais que je puisse ainsi faire défiler (par mes boutons précédents et suivants) les autres lignes relatives à mon choix dans ce cas : "gribouille avec l'entreprise GESTOR".

Quand je fais appel à mes boutons précédents et suivants tels que je les ai codé, mais du fait que je suis complétement débutante il me manque dans ce cas ci une partie pour adapter, je ne fais que récupérer la première ligne suivante ou précédente , exemple:

j'ai Gribouille / GESTOR -> a/256

Bouton suivant: Gribouille / TARTEMPION -> c/452

Votre code me va très bien par ce que je selectionne dans les combobox, mais alors comment puis je juste en activant mon bouton précédent et suivant , voici actuellement le code pour mes deux boutons précédents et suivants , encore merci pour votre aide:

'pour précedent

Private Sub CommandButton10_Click()

If ComboBox2.ListIndex > 0 Then

ComboBox2.ListIndex = ComboBox2.ListIndex - 1

Else

MsgBox "Il n'existe pas d'enregistrement précédent."

End If

'pour suivant

Private Sub CommandButton9_Click()

If ComboBox2.ListIndex < (ComboBox2.ListCount - 1) Then

ComboBox2.ListIndex = ComboBox2.ListIndex + 1

Else

MsgBox "Vous avez atteint la fin des enregistrements."

End If

End Sub

Le 27/02/2019 à 13:07

Bonjour,

J'ai remplacé vos 2 boutons "suivant" et "précédent" par une scrollbar à insérer dans votre formulaire

Les lignes à afficher sont gérées via une variable tableau au niveau du module. La ligne courante affichée est également une variable au niveau module.

Ajout du tri des titres et entreprises via ma fonction personnalisée de tri d'un dictionnaire.

ci-dessous code modifié et correctement indenté.

NB : le nombre de lignes d'une feuille est variable selon la version d'Excel, mieux vaut utiliser des instructions génériques.

Option Explicit

Dim Ws As Worksheet
Dim NbLignes As Integer
Dim Titres As Object, Entreprises As Object
Dim Lignes(), Ligne As Long

Private Sub UserForm_Initialize()
    Dim j As Long 'déclare la variable J
    Dim i As Integer

    Set Ws = Sheets("Base")
    NbLignes = Ws.Columns("A").Find("*", SearchDirection:=xlPrevious).Row

    With Me.ComboBox2
        .ColumnCount = 1
    End With

    InitCombo1
End Sub

Sub InitCombo1()
    Dim i As Integer, j As Long
    Dim titre As String, entreprise As String
    Dim tb_lignes()

    Set Titres = CreateObject("Scripting.dictionary")
    For j = 2 To NbLignes
        titre = Ws.Range("A" & j).Value
        entreprise = Ws.Range("B" & j).Value
        If Not Titres.exists(titre) Then Set Titres(titre) = CreateObject("Scripting.dictionary")
        Set Entreprises = Titres(titre)
        If Not Entreprises.exists(entreprise) Then Entreprises(entreprise) = Array(): i = 0
        tb_lignes = Entreprises(entreprise): ReDim Preserve tb_lignes(i): tb_lignes(i) = j: i = i + 1
        Entreprises(entreprise) = tb_lignes
        Set Titres(titre) = Entreprises
    Next j
    Call tri_dico_AZ(Titres)

    With Me.ComboBox1
        .Clear
        If Titres.Count > 0 Then .List = Application.Transpose(Titres.keys)
    End With
End Sub

Private Sub ComboBox1_Change()
    Dim j As Long
    Dim entreprise As Variant
    If Me.ComboBox1.ListIndex = -1 Then Exit Sub

    Nettoyage
    Set Entreprises = Titres(Me.ComboBox1.Value)
    Call tri_dico_AZ(Entreprises)

    With Me.ComboBox2
        .Clear
        If Entreprises.Count > 0 Then .List = Application.Transpose(Entreprises.keys)
    End With

End Sub

Private Sub ComboBox2_Change()
    If Me.ComboBox2.ListIndex = -1 Then Exit Sub

    Nettoyage
    Lignes = Entreprises(Me.ComboBox2.Value)
    Me.ScrollBar1.Min = 0: Me.ScrollBar1.Max = UBound(Lignes): Me.ScrollBar1.Value = Me.ScrollBar1.Min
    ScrollBar1_Change

End Sub

Private Sub ScrollBar1_Change()
    Dim i As Integer

    Ligne = Lignes(ScrollBar1.Value)
    For i = 1 To 15
        Me.Controls("TextBox" & i) = Ws.Cells(Ligne, i).Value
    Next i

End Sub

Sub Nettoyage()
    Dim i As Integer
    For i = 1 To 15
        Me.Controls("TextBox" & i) = ""
    Next i
End Sub

'Pour le bouton Modifier
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim i As Integer
    Dim Ctrl As Control

    If Me.ComboBox1.ListIndex = -1 Then Exit Sub

    For i = 1 To 15
        If Me.Controls("TextBox" & i).Visible = True Then Ws.Cells(Ligne, i) = Me.Controls("TextBox" & i).Value
    Next i
    MsgBox ("Modification, Compl?ment enregistr?s")
    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton4_Click()
    Application.ScreenUpdating = False
    Dim Ligne As Integer
    Dim i As Integer

    If MsgBox(" Ajout ?", vbYesNo, "Demande de confirmation") = vbNo Then Exit Sub

    Ligne = Ws.Columns("A").Find("").Row 'Permet de se positionner sur la dernière ligne de tableau NON VIDE
    For i = 1 To 15
        Ws.Cells(Ligne, i) = Me.Controls("TextBox" & i).Value
    Next i

    ' Affiche une boîte de message
    MsgBox ("Nouvelle saisie enregistrée")

    Unload Me ' Vide et ferme l'Userform ( formulaire)
    UserForm1.Show vbModeless 'Affiche le formulaire
    Application.ScreenUpdating = True
End Sub

Function tri_dico_AZ(ByVal dico As Object)
    Dim tb_clés(): ReDim tb_clés(dico.Count)
    Dim tb_items(): ReDim tb_items(dico.Count)
    Dim clé As Variant, clé1 As Variant
    Dim nb_sup As Long, i As Long

    '// Stockage d'une clé et de l'item correspondant respectivement dans les tableaux tb_clés et tb_items
    '//          selon le nombre de fois où l'ensemble des clés est inférieur ou égal à la clé courante
    For Each clé1 In dico.keys
        i = 0
        For Each clé In dico.keys
            If clé <= clé1 Then i = i + 1
        Next clé
        tb_clés(i) = clé1
        If IsObject(dico(clé1)) Then Set tb_items(i) = dico(clé1) Else tb_items(i) = dico(clé1)
    Next clé1

    '// Réinitialisation du dictionnaire et remplissage à partir des tableaux tb_clés et tb_items
    dico.RemoveAll
    For i = 1 To UBound(tb_clés)
        dico.Add tb_clés(i), tb_items(i)
    Next i

End Function
Le 27/02/2019 à 13:36

Tout d'abord je tiens infiniment à vous remercier, cela m'aide énormément et je reprends goût à persévérer...

Mon formulaire ne fonctionne pas car il s'arrête, à la combobx2 , en surlignant en jaune :

Lignes (il m'indique un message erreur de compilation, variable non définie)

Sniff sniff...

J'ai bien intégré les scollbar comme indiqué.

Merci beaucoup.

Le 27/02/2019 à 13:43

NE PAS TENIR COMPTE DE MON PRECEDENT POST,

JE n'avais pas repris le tout début "OPTION EXPLICIT"!!!Quelle andouille...

MERCI THEV encore et encore, si vous saviez comment j'ai cherhché pendant des semaines sans arriver à un résultat concret!!!

Je termine comme cela est indiqué par le forum, par le petit logo résolu, mais encore une fois mille mercis pour cette attention que vous m'avez alors consacré et les bons codes afin d'arriver à quelques choses !!!

Site d'entres aides super!!!

Le 27/02/2019 à 13:45
Mistinguette a écrit :

Lignes (il m'indique un message erreur de compilation, variable non définie)

Vous avez sans doute oublié les déclarations de variable au niveau du module avant toute procédure Sub

Option Explicit

Dim Ws As Worksheet
Dim NbLignes As Integer
Dim Titres As Object, Entreprises As Object
Dim Lignes(), Ligne As Long

Private Sub UserForm_Initialize()

Par ailleurs, j'ai amélioré ma réponse précédente en ajoutant le tri de vos titres et entreprises dans vos Comboboxes.

Rechercher des sujets similaires à "vba combobox seconde reste doublon"