Theo yêu cầu bạn xem đài nhé 
Tuy nhiên kết quả của mình khác của bạn ấy đoạn kết quả cuối (phần highline) nên hơi lăn tăn có đúng ý không
Function ThongKe(st As String) As String
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Do While Len(st) > 0
If Len(st) > 1 Then
For i = 1 To Len(st)
If Mid(st, i, 1) <> Mid(st, i + 1, 1) Then Exit For
Next
temp = Mid(st, 1, i)
st = Mid(st, i + 1, Len(st) - i)
Else
temp = st
st = ""
End If
If Not dic.exists(temp) Then
dic.Add temp, 1
Else
dic(temp) = dic(temp) + 1
End If
Loop
For Each Key In dic
ThongKe = ThongKe & dic(Key) & ":" & Len(Key) & Mid(Key, 1, 1) & ", "
Next
ThongKe = Mid(ThongKe, 1, Len(ThongKe) - 2)
End Function
