Макрос для вывода наиболее часто встречающийся в тексте символа.

Sub m_1()
Dim myArray() As String
Dim i As Long
Dim j As Long
Dim MaxPrevious As Long
Dim MaxCurrent As Long
Dim vСимвол As String
ReDim myArray(Selection.Characters.Count)
For i = 0 To UBound(myArray)
    myArray(i) = Mid(Selection.Text, i + 1, 1)
Next i
MaxPrevious = 0
For i = 0 To UBound(myArray)
    MaxCurrent = 0
    For j = 0 To UBound(myArray)
        If UCase(myArray(i)) = UCase(myArray(j)) Then
            MaxCurrent = MaxCurrent + 1
        End If
    Next j
    If MaxCurrent > MaxPrevious Then
        MaxPrevious = MaxCurrent
        vСимвол = myArray(i)
    End If
Next i
Debug.Print vСимвол
End Sub

Sub m_1()
Dim myArray() As String
Dim i As Long
Dim j As Long
Dim MaxPrevious As Long
Dim MaxCurrent As Long
Dim vСимвол As String
Dim vСтрокаБезПробелов As String
vСтрокаБезПробелов = Replace(Selection.Text, " ", "")
ReDim myArray(Len(vСтрокаБезПробелов))
For i = 0 To UBound(myArray)
    myArray(i) = Mid(vСтрокаБезПробелов, i + 1, 1)
Next i
MaxPrevious = 0
For i = 0 To UBound(myArray)
    MaxCurrent = 0
    For j = 0 To UBound(myArray)
        If UCase(myArray(i)) = UCase(myArray(j)) Then
            MaxCurrent = MaxCurrent + 1
        End If
    Next j
    If MaxCurrent > MaxPrevious Then
        MaxPrevious = MaxCurrent
        vСимвол = myArray(i)
    End If
Next i
Debug.Print vСимвол
End Sub

Option Explicit
Sub m_2()
Dim t
Dim i As Long
t = Time
Dim Dict As Object
Dim MAX, SIMV
 
Set Dict = CreateObject("Scripting.Dictionary")
With Dict
    For i = 1 To 255
           .Add i, 0
    Next i
    For i = 1 To Len(Selection.Text)
        .Item(Asc(Mid(Selection.Text, i, 1))) = .Item(Asc(Mid(Selection.Text, i, 1))) + 1
        If MAX < .Item(Asc(Mid(Selection.Text, i, 1))) Then
         MAX = .Item(Asc(Mid(Selection.Text, i, 1)))
         SIMV = Mid(Selection.Text, i, 1)
        End If
    Next i
End With
    For i = 1 To 255
   Debug.Print i, Chr(i), Dict.Item(i)
    Next i
 
Debug.Print IIf(SIMV = " ", "пробел", SIMV) & " - " & Dict.Item(Asc(SIMV))
Debug.Print Format((Time - t), "nn:ss")
End Sub

Option Explicit
Sub m_2()
Dim t, TM
Dim i As Long
Dim J As Long
Dim Dict As Object
Dim MAX, SIMV
Dim rez()
ReDim rez(1, 0)
t = Time
Set Dict = CreateObject("Scripting.Dictionary")
With Dict
    For i = 1 To 255
           .Add i, 0
    Next i
    For i = 1 To Len(Selection.Text)
        .Item(Asc(Mid(Selection.Text, i, 1))) = .Item(Asc(Mid(Selection.Text, i, 1))) + 1
        If MAX < .Item(Asc(Mid(Selection.Text, i, 1))) Then
         MAX = .Item(Asc(Mid(Selection.Text, i, 1)))
         SIMV = Mid(Selection.Text, i, 1)
        End If
    Next i
End With
'сортировка
    For i = 0 To 255
    TM = ""
        If Dict.Item(i) > 0 Then
            ReDim Preserve rez(1, UBound(rez, 2) + 1)
            rez(0, UBound(rez, 2)) = i
            rez(1, UBound(rez, 2)) = Dict.Item(i)
                For J = UBound(rez, 2) To 1 Step -1
                    If rez(1, J) > rez(1, J - 1) Then
                        TM = rez(0, J): rez(0, J) = rez(0, J - 1): rez(0, J - 1) = TM
                        TM = rez(1, J): rez(1, J) = rez(1, J - 1): rez(1, J - 1) = TM
                    End If
                Next J
        End If
    Next i
    For i = 0 To UBound(rez, 2)
   Debug.Print i, rez(1, i), IIf(rez(0, i) = 32, "пробел", Chr(rez(0, i)))
    Next i
Debug.Print IIf(SIMV = " ", "пробел", SIMV) & " - " & Dict.Item(Asc(SIMV))
Debug.Print Format((Time - t), "nn:ss")
End Sub

Sub test()
Dim t$, tt As String * 1, t2$, i as Byte
t = "tftfasefgvhwaegfyw"
ReDim arr(1 To 255, 1 To 2)
For i = 1 To 255
tt = ChrW(i)
t2 = Replace(t, tt, "")
arr(i, 1) = tt
arr(i, 2) = Len(t) - Len(t2)
Debug.Print arr(i, 1); arr(i, 2)
t = t2
Next
End Sub

i as long

i As Integer

Sub test()
Dim ttt, J, TM
ttt = Time
Dim t$, tt As String * 1, t2$, i As Integer
t = Selection.Text
ReDim arr(1 To 255, 1 To 2)
For i = 1 To 255
tt = ChrW(i)
t2 = Replace(t, tt, "")
arr(i, 1) = tt
arr(i, 2) = Len(t) - Len(t2)
t = t2
Next i
For i = 1 To 254
    For J = 255 To i + 1 Step -1
        If arr(J, 2) > arr(J - 1, 2) Then
            TM = arr(J, 2): arr(J, 2) = arr(J - 1, 2): arr(J - 1, 2) = TM
            TM = arr(J, 1): arr(J, 1) = arr(J - 1, 1): arr(J - 1, 1) = TM
        End If
    Next J
Next i
For i = 1 To 254
If arr(i, 2) > 0 Then
Debug.Print arr(i, 1); arr(i, 2)
Else
Debug.Print Format((Time - ttt), "nn:ss")
Exit Sub
End If
Next i
End Sub

Sub test(): Dim t$, i As Byte, arr&(0 To 255)
t = "Съешь-ка ещё 1/2 франц. булки да выпей чаю!"
    Do
        arr(i) = Len(t) - Len(Replace(t, Chr(i), ""))
        'символ с кодом i в исследуемой строке t найден в количестве arr(i)
        Debug.Print Chr(i); IIf(arr(i) > 0, Space(1) & arr(i) & vbTab, vbTab);
        'напечатали символ Chr(i) и, через пробел, его кол-во (если оно > 0)
        If i Mod 16 = 0 Then Debug.Print 'новая строка после кода, кратного 16
        i = i + 1
    Loop Until i = 255
End Sub