XL 2013 [ Résolu ] extraire le caractère le plus présent dans une chaîne de caractères

Private Sub Combobox1_Change()
If ComboBox1.ListIndex = -1 Then ComboBox1 = 1
ActiveCell.Activate
If ActiveSheet.Name = Me.Name Then [F1] = Val(ComboBox1): Worksheet_SelectionChange Selection
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n%, P As Range, d As Object, t, ncol%, i&, j%, x$, s, k%, a, b, c()
n = Val(ComboBox1)
[K1] = 0: ListBox1.ListFillRange = "" 'RAZ
Cells.FormatConditions.Delete 'RAZ MFC
If Application.CutCopyMode Then Exit Sub 'permet le copier-coller
Set P = Intersect(Selection, Me.UsedRange)
If P Is Nothing Then Exit Sub
P.FormatConditions.Add xlExpression, Formula1:="=1" 'création de la MFC
P.FormatConditions(1).Interior.ColorIndex = 1 'noir
P.FormatConditions(1).Font.ColorIndex = 2 'police blanche
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each P In P.Areas
  t = P.Resize(P.Rows.Count + 1) 'au moins 2 éléments
  ncol = UBound(t, 2)
  For i = 1 To UBound(t) - 1
    For j = 1 To ncol
      x = Replace(Replace(Replace(CStr(t(i, j)), ".", ""), ",", ""), "'", "' ")
      s = Split(Replace(x, Chr(10), " "))
      For k = 0 To UBound(s)
        If Len(s(k)) >= n Then d(s(k)) = d(s(k)) + 1
Next k, j, i, P
If d.Count = 0 Then Exit Sub
a = d.Items: b = d.Keys
ReDim c(UBound(a), 1) 'base 0
For i = 0 To UBound(a)
  c(i, 0) = a(i)
  c(i, 1) = b(i)
Next
With Feuil3.[A1].Resize(i, 2) 'CodeName
  .EntireColumn.ClearContents
  .Value = c
  .Sort .Columns(1), xlDescending, .Columns(2), , xlAscending, Header:=xlNo 'tri
  ListBox1.ListFillRange = .Address(External:=True)
End With
[K1] = d.Count
End Sub