Combobox en cascade avec saisie intuitive semie automatique

Question

Je suis tout nouveau dans le monde du VBA, et je m'arrache les cheveux sur un petit problème Mes connaissances en VBA sont encore très faible, mais j'ai réussi à bien avancer tout de même ^^ J'ai dans un classeur, plusieurs onglets contenant dans chacun d'eux une base de donnée relatifs aux prix d'entreprises différentes avec : en A : Une catégorie de travaux en B : La désignation des travaux en C : Prix pour une zone 1 en D : Prix pour une zone 2 etc ... Mon But pour l'instant est d'avoir une liste déroulante pour choisir l'entreprise (ça c'est fait) Un liste déroulante pour choisir la région (C'est fait) Un comboBox qui contient toutes les grandes catégories des travaux (la colone A des bases de données sans doublon) , relatif à l'entreprise choisit (C'est fait ! ) Pour ça j'ai créé une fonction matricielle pour créé une colonne "Catégorie sans doublon", maintenant je vois que c'est possible de le faire directement dans la ComboBox, je le ferais plus tard car cela fonctionne très bien pour le moment. Avec saisie semi automatique et recherches des lettres nimporte où, pas juste en début de phrase. Et la où je bloque : Un ComboBox2 qui va, en fonction de l'entrerise choisi, et de la catégorie de travaux choisis, faire la liste des désignation des travaux possibles (Colone B lorsque colone A = Combobox1) J'y suis presque arrivé, mais il y a un problème dès que j’essaie de mettre la saisie semie automatique ! Voici la code de la page au complet : (je suis VRAIMENT débutant, de quelques jours ^^, toutes remarques sera bien prise ) Dim a() Dim b() Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Range("Tableau7&#91;Categorie&#93;"), Target) Is Nothing And Target.Count = 1 Then If Cells(Target.Row, Target.Column - 2).Value = "Ent1" Then a = Application.Transpose(Sheets("Ent1").Range("Tableau16")) ElseIf Cells(Target.Row, Target.Column - 2).Value = "Ent2" Then a = Application.Transpose(Sheets("Ent2").Range("N1FMB")) ElseIf Cells(Target.Row, Target.Column - 2).Value = "Ent3" Then a = Application.Transpose(Sheets("Ent3").Range("Tableau5")) ElseIf Cells(Target.Row, Target.Column - 2).Value = "Ent4" Then a = Application.Transpose(Sheets("Ent4").Range("Tableau6")) Else Exit Sub End If 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 'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule Else Me.ComboBox1.Visible = False End If If Not Intersect(Range("Tableau7&#91;Designation&#93;"), Target) Is Nothing And Target.Count = 1 Then ComboBox2.Clear Dim FL1 As Range, NoCol As Integer Dim NoLig As Long, Var As Variant, Var2 As Variant Set FL1 = Sheets("Ent1").Range("Tableau11") NoCol = 1 'lecture de la colonne 1 iii = 0 jjj = 0 For NoLig = 1 To Split(FL1.Address, "$")(4) Var = FL1.Cells(NoLig, NoCol) Var2 = FL1.Cells(NoLig, NoCol + 1) If Cells(Target.Row, Target.Column - 1) = Var Then ComboBox2.AddItem Var2 End If Next Set FL1 = Nothing Me.ComboBox2.Height = Target.Height + 3 Me.ComboBox2.Width = Target.Width Me.ComboBox2.Top = Target.Top Me.ComboBox2.Left = Target.Left Me.ComboBox2 = Target Me.ComboBox2.Visible = True Me.ComboBox2.Activate 'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule Else Me.ComboBox2.Visible = False End If End Sub Private Sub ComboBox1_Change() If Me.ComboBox1 &lt;&gt; "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then Set d1 = CreateObject("Scripting.Dictionary") tmp = "*" &amp; UCase(Me.ComboBox1) &amp; "*" 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_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.ComboBox1.List = a Me.ComboBox1.Activate Me.ComboBox1.DropDown End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(1).Select End Sub Private Sub ComboBox2_Change() If Me.ComboBox2 &lt;&gt; "" And IsError(Application.Match(Me.ComboBox2, Me.ComboBox2.List, 0)) Then Set d1 = CreateObject("Scripting.Dictionary") tmp = "*" &amp; UCase(Me.ComboBox1) &amp; "*" For Each c In Me.ComboBox2.List If UCase(c) Like tmp Then d1(c) = "" Next c Me.ComboBox2.List = d1.keys Me.ComboBox2.DropDown End If ActiveCell.Value = Me.ComboBox2 End Sub Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.ComboBox2.Activate Me.ComboBox2.DropDown End Sub Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(1).Select End Sub Voila Voila, je triture ça depuis un moment, mais j'ai toujours un bug avec Private Sub ComboBox2_Change() Je pense que c'est Me.ComboBox2.List qui pose problème dans tout le Sub, mais je ne sais pas pourquoi. Me.ComboBox2.List = d1.keys &gt; autorisation denied Soit j'arrive à afficher la bonne liste combobox2, mais la saisie auto ne fonctionne pas. Soit j'arrive à la faire fonctionner, mais dès que je choisi un élément de la liste, ça plante Je ,e pourrai répondre que ce soir A+ ! Et merci ...

Boisgontierjacques · Answer

Exemple avec 3 niveaux intuitifs Boisgontier...

Boisgontierjacques · Answer

Il ne faut pas utiliser AddItem qui est lent mais . List ou . Column J'ai un pgm de recherche intuitif sur 36.000 communes. http://boisgontierjacques.free.fr/fichiers/Formulaire/CommunesCP.zip Boisgontier...

Boisgontierjacques · Answer

Si c'est Transpose qui est le problème,il suffit de ne pas l'utiliser. Boisgontier...

Steelson · Answer

A toutes fins utiles, une proposition qui compile certainement plusieurs codes prélevés à droite et à gauche, il doit y avoir un zeste puissant de JacquesBoigintier, du Quicksort, du Scripting.Dictionary, et du ListObjects (tableaux) ... donc rapide (charge le tableau d'un seul coup), supprime les doublons avec dico, et trie la liste La présentation est un userform mais je pense avoir aussi travaillé directement sur la feuille excel comme JacquesBoigontier le propose...

Steelson · Answer

L'autre version ... ce ne sont pas des combobox ici mais des listes de validation.

Const nbZones = 8

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim data() As Variant
Dim choix() As Variant
Dim dico As Object
Dim i&, iData&, iZone&, plus&

    If Target.Count <> 1 Then Exit Sub
    plus = Target.Row - 1
    If plus = 0 Then Exit Sub

    ReDim choix(1 To nbZones)
    For i = 1 To nbZones
        choix(i) = Range("zone" & i).Offset(plus, 0).Value
        If Not Intersect(Range("zone" & i).Offset(plus, 0), Target) Is Nothing Then
            data = [TabData].Value
            Set dico = CreateObject("Scripting.Dictionary")
            For iData = 1 To UBound(data)
                flag = True
                If i > 1 Then
                    For iZone = 1 To i - 1
                        If choix(iZone) <> CStr(data(iData, iZone)) Then flag = False
                    Next
                End If
                If flag Then dico(CStr(data(iData, i))) = ""
            Next iData
            If dico.Count > 0 Then
                Target.Validation.Delete
                Target.Validation.Add xlValidateList, Formula1:=Join(dico.keys, ",")
            End If
            Exit For
        End If
    Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count <> 1 Then Exit Sub
    plus = Target.Row - 1
    If plus = 0 Then Exit Sub

    For i = 1 To nbZones
        If Not Intersect(Range("zone" & i).Offset(plus, 0), Target) Is Nothing Then
            If i < nbZones Then
                Application.EnableEvents = False
                For iZone = i + 1 To nbZones
                    With Range("zone" & iZone).Offset(plus, 0)
                        .Value = ""
                        .Validation.Delete
                    End With
                Next
                Application.EnableEvents = True
            End If
            Exit For
        End If
    Next

End Sub

C'est complètement paramétré.

Le tableau de base doit s'appeler TabData

Une constante en début de macro définit le nombre de colonnes, ici 8

Les en-têtes de colonnes de la page dans laquelle s'affichent les listes déroulantes doivent s'appeler zone1, zone2 etc ...

Voir l'exemple ci-après

94liste-deroulante-en-cascade-tableau-et-plages-parametrees.xlsm (158.18 Ko)

Steelson · Answer

MonDico.Add C.Value, C.Value Essaie plutôt : MonDico(C.Value)="" sinon prend le code que je t'ai proposé.....