VLOOKUP meerdere resultaten

[ag10088]

Hallo,

Ik gebruik meestal de standaard VLOOKUP funtie.
Maar ik wil nu een VLOOKUP funtie (of iets dergelijks) gebruiken voor meerdere resultaten weer te geven.
Voorbeeld bestand is bijgevoegd.

Vraag:

Van de waarde in kolom D "Tag zoeken" wil ik weten op welke displays hij voorkomt. In kolom A "Tagname" moet worden gezocht naar de waarde uit kolom D. Het resultaat "Display"in kolom B moet dan achter de gezochte "Tag zoeken" kolom D komen. Het nadeel is alleen dat er de "Tag zoeken"in kolom D dus op meedere Displays kan voorkomen. En met een normale VLOOKUP kom ik er dus niet aan uit.

Bedankt voor jullie hulp.

Bekijk bijlage VLOOKUP_Meerdere resultaten.xlsx

 

[Quiby]

Is een draaitabel zoals in de bijlage misschien een oplossing?
Op deze manier is ook te zien welke displays er bij een tagname horen
Bekijk bijlage VLOOKUP_Meerdere resultaten Q.xlsx

 

[ag10088]

Is een draaitabel zoals in de bijlage misschien een oplossing?
Op deze manier is ook te zien welke displays er bij een tagname horen
Bekijk bijlage 275893

Ja dat klopt, maar ik heb graag de kollomen horizontaal gevuld

 

[Quiby]

Hierbij een eventuele oplossing met formules. Mijn voorkeur zou toch uitgaan naar de draaitabel, omdat er nu veel formules berekend dienen te worden wat tijd kost.

Optie 1
Hierbij ga ik er vanuit dat dezelfde tags altijd na elkaar komen. wanneer dit niet het geval is werkt dit niet.
Bekijk bijlage VLOOKUP_Meerdere resultaten Q.xlsx

Optie 2
Hier wordt eerst een draaitabel gemaakt waardoor dezelfde tags bij elkaar staat.
Bekijk bijlage VLOOKUP_Meerdere resultaten Q2.xlsx

 

[ag10088]

Hierbij een eventuele oplossing met formules. Mijn voorkeur zou toch uitgaan naar de draaitabel, omdat er nu veel formules berekend dienen te worden wat tijd kost.

Optie 1
Hierbij ga ik er vanuit dat dezelfde tags altijd na elkaar komen. wanneer dit niet het geval is werkt dit niet.
Bekijk bijlage 275899

Optie 2
Hier wordt eerst een draaitabel gemaakt waardoor dezelfde tags bij elkaar staat.
Bekijk bijlage 275901

Bedankt hiermee kan ik goed verder!

 

[snb]

Dit lijkt me voor de hand liggender:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion
  
  With CreateObject("scripting.dictionary")
     For j = 2 To UBound(sn)
        If .exists(sn(j, 1)) Then
          st = .Item(sn(j, 1))
          For jj = 1 To UBound(st)
            If st(jj) = "" Then Exit For
          Next
          st(jj) = sn(j, 2)
          .Item(sn(j, 1)) = st
        Else
          .Item(sn(j, 1)) = Split(sn(j, 1) & " " & sn(j, 2) & Space(80))
        End If
     Next
     
     Sheet1.Cells(1, 14).Resize(.Count, 80) = Application.Index(.items, 0, 0)
  End With
  
End Sub

 

[WHER]

Nog een alternatief waarbij de Items van de hoofd-dictionary op hun beurt uitgevoerd worden als dictionary.
Iets "langdradiger" maar het getal 80 hoeft niet eerst uitgerekend/ingeschat te worden.
Meer interactie met het werkblad bij het wegschrijven van de resultaten.
Gelijklopende resultaten in het voorbeeld, maar een potentieel verschil indien een gegeven Display meerdere keren zou voorkomen bij een gegeven Tagname.

Sub tst()
    
    Dim dic As Object, dic2 As Object
    Dim Contents As Variant, ParentKeys As Variant, ChildKeys As Variant
    Dim r As Long
    
    
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    
     
        Contents = Sheet1.Cells(1).CurrentRegion
     
       For r = 2 To UBound(Contents, 1)
         If dic.Exists(Contents(r, 1)) Then
            Set dic2 = dic.Item(Contents(r, 1))
            If dic2.Exists(Contents(r, 2)) Then
                dic2.Item(Contents(r, 2)) = dic2.Item(Contents(r, 2))
             Else
                dic2.Add Contents(r, 2), ""
            End If
          Else
            Set dic2 = CreateObject("Scripting.Dictionary")
            dic2.CompareMode = vbTextCompare
            dic2.Add Contents(r, 2), ""
            dic.Add Contents(r, 1), dic2
          End If
        Next r
      
   
    ParentKeys = dic.Keys
    
   
        For r = 0 To UBound(ParentKeys)
         
          Sheet1.Cells(r + 1, 14) = ParentKeys(r)
          
            Set dic2 = dic.Item(ParentKeys(r))
            
            ChildKeys = dic2.Keys
           
         
          Sheet1.Cells(r + 1, 15).Resize(, dic2.Count) = Application.Index(ChildKeys, 0, 0)
         
        Next r
  
    Set dic2 = Nothing
    Set dic = Nothing
    Application.ScreenUpdating = True
End Sub

 

[snb]

Maar...., het kan ook anders