Réduire puis développer une listbox

Bonjour,

Je suis en train de travailler sur un dossier de suivi de prod.

J'ai plusieurs dossier colonne B

J'ai réussi à mettre dans une listbox1 mes noms de dossiers SANS les doublons.

Maintenant il faut que quand je clic sur un nom de dossier dossier dans ma listbox1 cela développe les lignes qui comporte le même nom dans ma listbox2

Par exemple si je clic sur PRESLES dans listbox1

listbox2 ressort les éléments de la colonne D + E + F + G

AR+BA57+63424040

GA61447000

FPA 3 72 7000

FA 193047000

PENE5566000

Voici mon code pour le moment

Dim f, a()
Private Sub UserForm_Initialize()
  Set f = Sheets("dossiers")
  a = f.Range("A2:C" & f.[B65000].End(xlUp).Row).Value
  Me.ListBox1.List = f.Range("B2:C" & f.[B65000].End(xlUp).Row).Value
  Set d = CreateObject("Scripting.Dictionary")
  j = 0
  Do While j < Me.ListBox1.ListCount
    tmp = ListBox1.List(j, 0) & ListBox1.List(j, 1)
    If Not d.exists(tmp) Then
      d(tmp) = ""
      j = j + 1
    Else
      Me.ListBox1.RemoveItem j
    End If
  Loop
End Sub
Private Sub listBox1_Click()
  Me.ListBox2 = Me.ListBox1.TextAlign

End Sub

Merci par avance de votre aide

Bonjour,

Voir exemple en PJ

Dim f, a()
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  a = f.Range("A2:D" & f.[B65000].End(xlUp).Row).Value
  Set d = CreateObject("Scripting.Dictionary")
  j = 0
  Dim b()
  For i = LBound(a) To UBound(a)
    tmp = a(i, 1) & a(i, 2)
    If Not d.exists(tmp) Then
      d(tmp) = ""
      Me.ListBox1.AddItem a(i, 1)
      Me.ListBox1.List(j, 1) = a(i, 2)
      j = j + 1
    End If
  Next i
End Sub

Private Sub listBox1_Click()
  Me.TextBox1 = Me.ListBox1.Column(0)
  Me.TextBox2 = Me.ListBox1.Column(1)
  Me.ListBox2.Clear
  j = 0
  For i = LBound(a) To UBound(a)
    If Me.ListBox1 = a(i, 1) And Me.ListBox1.Column(1) = a(i, 2) Then
      Me.ListBox2.AddItem a(i, 3)
      Me.ListBox2.List(j, 1) = a(i, 4)
      j = j + 1
    End If
  Next i
End Sub

Ceuzin

Voici mon fichier

Il faudrait que quand je clic sur presles cela me resorte que les lignes correspondante

Ce qui n'est pas le cas aujourd'hui

Je ne sais pas comment faire

cf PJ

Private Sub listBox1_Click()
  Me.ListBox2.Clear
  j = 0
  For i = LBound(a) To UBound(a)
    If Me.ListBox1 = a(i, 1) And Me.ListBox1.Column(1) = a(i, 2) Then
      Me.ListBox2.AddItem a(i, 3)
      Me.ListBox2.List(j, 1) = a(i, 4)
      Me.ListBox2.List(j, 2) = a(i, 5)
      Me.ListBox2.List(j, 3) = a(i, 6)
      j = j + 1
    End If
  Next i
End Sub

Ceuzin

Merci beaucoup pour ta rapidité cela fonctionne très bien

Bonne soirée à toi et bon week end