Top5 formule

[koster1984]

Beste experts,

Ik zoek naar een manier om op een simpele manier een top5 te maken van een reeks kenmerken met daarachter een bedrag.

In E1:E5 heb ik 1 t/m 5 staan en in F1:F5 heb ik een combi van GROOTSTE, SOM.ALS en UNIEK gebruikt om de grootste 5 sommen naar voren te krijgen:

=GROOTSTE(SOM.ALS(A:A;UNIEK(A:A);B:B);E1)

Wat ik echter zoek is nog een manier om het bijbehorende kenmerk ook op te halen. Ik heb tot nu toe iets heel omslachtigs (in G1:G5):

=LINKS(INDEX(UNIEK(A:A)&SOM.ALS(A:A;UNIEK(A:A);B:B);VERGELIJKEN(F1;DEEL(UNIEK(A:A)&SOM.ALS(A:A;UNIEK(A:A);B:B);2;99)+0;0));1)

Maar zoals je in het voorbeeld bestand ook ziet, wanneer er twee kenmerken zijn met dezelfde som komt er twee keer hetzelfde kenmerk te staan.

Ik weet zeker dat dit op een veel betere manier moet kunnen, zou iemand mij willen helpen? Oplossing in VBA is ook welkom.

 

[popipipo]

Maak gebruik van een draaitabel.

 

[AlexCEL]

Optie met functie SORTEREN.OP in bijlage.

Feit dat je een "top 5" wilt maakt het e.e.a. wel wat complexer. Complete gesorteerde lijst is simpeler...

 

[koster1984]

Dat lijkt goed te werken Alex, wat houdt dat #-je in achter E1?

 

[koster1984]

Hoe zou ik dit in vba doen? Weet iemand dat ook?

 

[AlexCEL]

De #-wil zeggen dat hij vanaf E1 t/m het einde van de lijst moet kijken. In Excel 365 ken je zoiets als een dynamische lijst... Heb je al eens een #OVERLOOP fout gehad? Het heeft daarmee te maken.

 

[koster1984]

Aah ok, en dat werkt alleen in 365?

Ik heb hem even zo in vba vertaald:

Sub AlexFormule()
Dim a As Variant, b As Variant, i As Long
a = WorksheetFunction.Transpose(Evaluate("=SORTBY(UNIQUE(A:A),SUMIF(A:A,UNIQUE(A:A),B:B),-1)"))
b = WorksheetFunction.Transpose(Evaluate("=SORTBY(SUMIF(A1:A1000,UNIQUE(A1:A1000),B1:B1000),SUMIF(A1:A1000,UNIQUE(A1:A1000),B1:B1000),-1)"))
For i = 1 To 5
    Cells(i, 3) = a(i)
    Cells(i, 4) = b(i)
Next
End Sub

 

[VenA]

Formules nabouwen in VBA is meestal niet zo'n goede gedachte en al helemaal niet als je ze statisch maakt.

 

[JEC.]

Deze zal hetzelfde doen

Edit: over top 5 heengelezen.. aangepast nu

Sub j()
jv = Cells(1).CurrentRegion
  With CreateObject("scripting.dictionary")
     For i = 1 To UBound(jv)
       .Item(jv(i, 1)) = .Item(jv(i, 1)) + jv(i, 2)
     Next
        Cells(1, 12).Resize(.Count, 2) = Application.Transpose(Array(.items, .keys))
      With Cells(1, 12).CurrentRegion
       .Sort Cells(1, 12), 2
       .Offset(5).ClearContents
      End With
  End With
End Sub

 

[koster1984]

Die dictionary ziet er interessant uit, doet inderdaad wat ik wil. Ik ga me daar eens in verdiepen. Dankjewel allemaal.