Fonction Mode Égaliter

Function modePlus(plage As Range) As Variant
    Dim c As Range, reponse() As String, nbRep As Long, i As Long
    Dim Dict As Variant, clé As String, lig As Long
    Dim tmp1 As Long, tmp2 As Long, fini As Boolean
    Dim arr() As Long

    Set Dict = CreateObject("Scripting.Dictionary")
    'comptage
    ReDim reponse(1 To plage.Cells.Count)
    For Each c In plage
        If c.Value <> "" Then Dict.Item(c.Value) = Dict.Item(c.Value) + 1
    Next c
    ' dict dans tableau
    ReDim arr(0 To Dict.Count - 1, 0 To 1)
    cles = Dict.Keys
    For lig = 0 To UBound(cles)
        arr(lig, 0) = cles(lig)
        arr(lig, 1) = Dict(cles(lig))
    Next lig
    ' tri qté décroissante
    Do
        fini = True
        For i = 0 To UBound(arr) - 1
            If arr(i, 1) < arr(i + 1, 1) Then
                tmp1 = arr(i, 0): tmp2 = arr(i, 1)
                arr(i, 0) = arr(i + 1, 0): arr(i, 1) = arr(i + 1, 1)
                arr(i + 1, 0) = tmp1: arr(i + 1, 1) = tmp2
                fini = False
            End If
        Next i
    Loop While Not fini
    ReDim reponse(1 To 1)
    reponse(1) = arr(0, 0)
    nbRep = 1
    For i = 1 To UBound(arr) - 1
        If arr(i, 1) = arr(i - 1, 1) Then
            reponse(nbRep) = reponse(nbRep) & "-" & arr(i, 0)
            'i = i + 1
        Else
            nbRep = nbRep + 1
            ReDim Preserve reponse(1 To nbRep)
            reponse(nbRep) = arr(i, 0)
        End If
    Next i
    If plage.Columns.Count = 1 Then
        ' matrice verticale
        modePlus = Application.Transpose(reponse)
    Else
        ' matrice horizontale
        modePlus = reponse
    End If
End Function