liste de validation sans doublon et cascade.

[Jouxte]

Bonjour à toutes et tous,
Il y a déjà beaucoup de posts sur ce sujet, mais aucun ne correspond vraiment à ce que je cherche.
L'onglet "Tarif" comprend plus de 3 000 lignes, plus de 1 300 produits différents et 100 conditionnements différents.
J'aurais souhaité dans l'onglet "Adh" créer une liste déroulante des 1 300 produits (B10:B58) sans doublons et si possible par ordre alphabétique, en déterminer en colonne E les conditionnements possibles pour le produit sélectionné colonne B, de sorte à pouvoir en déterminer la référence en colonne D.
Merci par avance pour votre aide si possible sans macro.
Ci-joint fichier.

 

[BOISGONTIER]

Bonjour,

>Le userbox est parfait (produit et conditionnement) mais les données à coller sont produit (en colonne B), la Ref (en colonne D) et le volume de la colonne D du tarif (en colonne E ) au lieu du Cond.

Les formules sont supprimées.

Dim f, choix1(), Tbl()
Private Sub UserForm_Initialize()
    Set f = Sheets("tarif")
    Tbl = f.Range("a2:h" & f.[b65000].End(xlUp).Row).Value
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(Tbl)
      d(Tbl(i, 2)) = ""
    Next i
    choix1 = Application.Transpose(d.keys)
    Tri choix1, 1, LBound(choix1), UBound(choix1)
    Me.ComboBox1.List = choix1
End Sub

Private Sub ComboBox1_Change()
   mots = Split(Trim(Me.ComboBox1), " ")
   temp = Application.Transpose(choix1)
   For i = LBound(mots) To UBound(mots)
     temp = Filter(temp, mots(i), True, vbTextCompare)
   Next i
   Me.ComboBox1.List = temp
   Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox1_Click()
    Set d1 = CreateObject("Scripting.Dictionary")
    produit = Me.ComboBox1
    For i = 1 To UBound(Tbl)
      If produit = Tbl(i, 2) Then d1(Tbl(i, 3)) = ""
    Next i
    Me.ComboBox2.List = d1.keys
End Sub

Private Sub b_ok_Click()
  ActiveCell = Me.ComboBox1
  produit = Me.ComboBox1
  cond = Me.ComboBox2
  For i = 1 To UBound(Tbl)
    If Tbl(i, 2) = produit And Tbl(i, 3) = cond Then
      ActiveCell.Offset(, 2) = Tbl(i, 1)
      ActiveCell.Offset(, 3) = Tbl(i, 4)
      ActiveCell.Offset(, 4) = Tbl(i, 7)
    End If
  Next i
  Unload Me
End Sub

jb

 

[Jouxte]

Bonjour jb, le Forum,
Comme disent les jeunes, "trop top".

Un énorme merci. bon dimanche.