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

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

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

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