XL 2013 Compter et classer ordre décroissant éléments dictionary

[erics83]

Bonjour,

A nouveau inspiré par les excellents tutos de JB, je cherche à compter et classer par ordre décroissant. J'ai pris un classeur test de JB où le but est de créer une liste à partir des éléments d'une colonne séparés par ";", une liste se crée et je cherche à compter le nombre de fois où est "pépé", par exemple et ensuite de classer la liste des sommes par ordre décroissant....

J'ai essayé avec

 Application.Sum(d1.items)

mais cela ne fonctionne pas....

Merci pour votre aide

 

[Lolote83]

Bonjour EricS83,
Avec la macro de JB, je ne sais pas, mais une fois ta liste trouvée en F2, tu peux mettre cette formule

=SOMMEPROD((NON(ESTERREUR(TROUVE(E2;$B$2:$B$19))))*1)

qui pourrait se traduire en VBA par :

Range("F2").Formula2R1C1 = "=SUMPRODUCT((NOT(ISERROR(FIND(RC[-1],R2C2:R19C2))))*1)"

@+ Lolote83

 

[erics83]

Merci Lolote83,

Effectivement c'est une piste, mais comme je souhaitais un classement décroissant...et éviter une formule matricielle (qui est très bien au demeurant, mais je '"entraine" avec les Dictionary...).

Merci pour votre aide,

 

[kiki29]

Salut, si curieux, à titre d'info Boisgontier

 

[erics83]

Merci kiki29,

C'est ma source d'inspiration....quand je disais JB, je pensais qu'on avait compris Boisgontier....mais vous avez raison, autant mettre le lien ....je l'ai remis partout dans le post....vous avez raison !
Et merci JB !

Merci,

 

[dysorthographie]

Bonsoir,

Sub test()
Const adChar = 129, adInteger = 3
Dim Rs As Object: Set Rs = CreateObject("ADODB.Recordset")
Rs.Fields.Append "Mots-Clefs", adChar, 50
Rs.Fields.Append "NB", adInteger
Rs.Open
 With Rs
For Each c In Range("b2:b" & [b65000].End(xlUp).Row)
    a = Split(c.Value, ";")
 
    For Each m In a
        .Filter = "[Mots-Clefs]='" & Trim(m) & "'"
        If .EOF Then .AddNew
        ![Mots-Clefs] = Trim(m)
        !NB = !NB + 1
        .Update
        .MoveFirst
        Next m
  
  Next c
  .Filter = "": .MoveFirst: .Sort = "NB desc, [Mots-Clefs] ASC"
End With
[E2].CopyFromRecordset Rs
Rs.Close: Set Rs = Nothing
End Sub

 

[laurent950]

Bonsoir,

Selon le principe Boisgontier

Sub transforme()
  Set d1 = CreateObject("scripting.dictionary")
  For Each c In Range("b2:b" & [b65000].End(xlUp).Row)
    a = Split(c.Value, ";")
    For Each m In a: d1(Trim(m)) = d1(Trim(m)) + 1: Next m
  Next c
  [E2].CurrentRegion.Offset(1).ClearContents: [F14].ClearContents
  [E2].Resize(d1.Count) = Application.Transpose(d1.Keys)
  [F2].Resize(d1.Count) = Application.Transpose(d1.Items)
  [E2].CurrentRegion.Offset(, 1).Sort key1:=[F2], Order1:=2, Header:=xlYes
  [F14] = Application.Sum(d1.Items)
End Sub

 

[patricktoulon]

bonsoir
vieux comme le monde comme un dico (keys/items) ou une collection
mais avec une fonction sort et tant d'autres

CreateObject(« System.Collections.SortedList ») – Grand Chaman Excel

plutôt comme un array mais avec des fonction bien intéressantes

CreateObject(« System.Collections.ArrayList ») – Grand Chaman Excel

les deux pouvant bien sur exclure les doublons

 

[dysorthographie]

Bonsoir Patrick,

je cherche à compter et classer par ordre décroissant.

les deux objet que tu proposes sont incapable de gérer ça!

 

[patricktoulon]

re
Bonsoir Robert
l'envers de croissant c'est bien décroissant non ?

 

[dysorthographie]

Ici la clé est Mots_Clefs et NB l'item c'est sur NB qu'on trie de façon décroissante! ce que SortedList et ArrayList ne font pas

Mots-Clefs	NB
arbre	10​
cloture	10​
fleurs	10​
herbe	10​
Maman	5​
Mamie	5​
Papa	5​
Pépé	5​
chaise	3​
nape	3​
table	3​

	​

 

[patricktoulon]

re
Bonjour robert
ben un petit tri bulbule alors comme ça vite fait
VBA/Formule matricielle

Sub test()
    x = in_order_TableauBul([A1:B11].Value, 2)
    [D1].Resize(UBound(x), UBound(x, 2)) = x
End Sub


Function in_order_TableauBul(tabl, col, Optional sens = 0)
    Dim i#, e#, x#
    If TypeName(tabl) = "Range" Then tabl = tabl.Value
    ReDim temp(UBound(tabl, 2))
    For i = 1 To UBound(tabl)
        For e = i + 1 To UBound(tabl)
            Select Case sens
            Case 0
                If tabl(e, col) > tabl(i, col) Then
                    For x = 1 To UBound(tabl, 2): temp(x) = tabl(i, x): tabl(i, x) = tabl(e, x): tabl(e, x) = temp(x): Next
                End If
            Case 1
                If tabl(e, col) < tabl(i, col) Then
                    For x = 1 To UBound(tabl, 2): temp(x) = tabl(i, x): tabl(i, x) = tabl(e, x): tabl(e, x) = temp(x): Next
                End If
            End Select
        Next
    Next
    in_order_TableauBul = tabl
End Function

on peu même des l'ors faire une fonction qui reprendrait le tableau avec les doublons du post 1 et faire tout d'un coup

il y a aussi ma fonction quick sort sur tableau 2 Dim (dans les deux sens ) sur colonne X aussi eventuellement pour les grands tableaux

 

[erics83]

Merci

dysorthographie,​

laurent950​

patricktoulon​

Merci pour ces solutions, je vais voir et essayer en fonction de mon code et classeur....mais vos solutions résolvent mon problème ...
MERCI pour votre aide,

​