formule gevraagd om rijen toe te voegen

[globe]

Ik heb een excel sheet met klanten codes en assortimenten en een lijst met welke merken er in deze assortimenten zitten.

Kan ik door een formule of evt VBA deze merken onder elkaar krijgen zodat ik een lijst krijg met klantcodes en merken.

In mijn voorbeeld zie je de bedoeling.

Assortimenten zijn variabel, in het ene assortiment zit 1 merk, sommige bestaan wel uit 10 merken.

Wie-o-wie helpt me in de goed richting?

Het tabblad assortimenten is aan te passen eventueel, dus als ik met hulpkolommen moet werken is het prima.

 

[cow18]

Sub test()
   ass = Sheets("assortiment").Range("A1").CurrentRegion   'je assortiment
   klant = Sheets("data").Range("A1").CurrentRegion   'je klanten
   Set dict = CreateObject("scripting.dictionary")   'dictionary aanmaken

   For i = 2 To UBound(klant)                    'alle klanten aflopen
      r = Application.Match(klant(i, 2), Application.Index(ass, 0, 1))   'zoek bijbehorende rij in assortiment
      If IsNumeric(r) Then                       'gevonden
         For j = 2 To UBound(ass, 2)             'alle merken aflopen
            If Len(ass(r, j)) > 0 Then           'merk is ingevuld
               dict.Add dict.Count, Array(klant(i, 1), ass(r, j))   'toevoegen aan dictionary
            End If
         Next
      End If
   Next

   Sheets("data").Range("C10").Resize(dict.Count, 2).Value = Application.Index(dict.items, 0, 0)   'resultaat wegschrijven
End Sub

 

[globe]

Hele fijne dit!

waanzinnig bedankt