Определить какие слова и сколько раз они встречаются в заданной строке

Option Explicit
Sub aa()
Dim st$, ar, t%, Ex%, Comp%, n%, tW$, res$
st = InputBox("Введите предложение: ", , "Ура, ура - я сделал программу и я сделал ее сам!")
res = "В предложении: " & st & vbCr
st = LCase(st)
st = Replace(Replace(Replace(Replace(Replace(Replace _
    (st, ".", " "), ",", " "), "-", " "), ";", " "), "!", " "), "?", " ") ':)
Do
    t = Len(st)
    st = Replace(st, "  ", " ")
Loop Until t = Len(st)
st = Trim(st)
ar = Split(st, " ")
For Ex = 0 To UBound(ar)
    If ar(Ex) <> "" Then
        tW = ar(Ex)
        For Comp = 0 To UBound(ar)
            If ar(Comp) <> "" Then
                If tW = ar(Comp) Then
                    n = n + 1
                    If n = 1 Then res = res & ar(Comp) & " - "
                    ar(Comp) = ""
                End If
            End If
        Next
        If n > 0 Then res = res & n & vbCr: n = 0
    End If
Next
MsgBox res
End Sub