Нужен скрипт для анализа текста и формирование статистики - VB

Формулировка задачи:

Программа анализирует произвольный текст (строку) и формирует его статистику. В статистику входит: количество знаков (всех символов, исключая знаки препинания и пробелы), количество абзацев (непустая часть текста между двумя переводами строки), количество предложений (непустая часть текста между двумя точками), количество слов (часть текста между двумя пробелами или знаком препинания и пробелом, частота встречаемости букв (в виде буква - количество раз, сколько она встретилась)

Решение задачи: «Нужен скрипт для анализа текста и формирование статистики»

textual
                            Листинг программы 
                        

                            Option Explicit
Option Compare Text
Const AlfaBet As String = "абвгдеёжзийклмнопрстухцчшщъыьэюя" & _
                          "abcdefghijklmnopqrstuvwxyz" & _
                          "1234567890"
Sub TextStatistic()
  Dim i As Long, ff As Integer, s As String, sTmp As String, nLet As Long, nRow
    ff = FreeFile
    'Open App.Path & "\1.txt" For Input As #ff
           ' s = Input(LOF(ff), 1)
    'Close #ff
    s = InputBox("Введите текст", "Ввод данных", "йцукенгшщзхъфывапролджэ  ,,..1234567889ю. ячсмитьбюё")
    sTmp = DelSymb(s)
    Cells(1, 1).Value = "Букв     - " & Len(Replace(sTmp, " ", ""))
    Cells(2, 1).Value = "Слов     - " & UBound(Split(sTmp)) + 1
    Cells(3, 1).Value = "Предлож. - " & UBound(Split(LetAndDot(s), "."))
    Cells(4, 1).Value = "Абзацев  - " & Tbl(s)
    nRow = 4
    For i = 1 To Len(AlfaBet)
        nLet = UBound(Split(sTmp, Mid(AlfaBet, i, 1)))
        If nLet <> 0 Then nRow = nRow + 1: Cells(nRow, 1).Value = Mid(AlfaBet, i, 1) & "  --  " & nLet
    Next i
End Sub
 
Function DelSymb(ByVal s As String) As String
    Dim st As String, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 1) Like "[0-9aA-zZаА-яЯёЁ ]" Then
             st = st & Mid(s, i, 1)
        Else
             st = st & " "
        End If
    Next i
    Do While InStr(1, st, "  ")
             st = Replace(st, "  ", " ")
    Loop
    DelSymb = st
End Function
 
Function LetAndDot(ByVal s As String) As String
    Dim st As String, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 1) Like "[0-9aA-zZаА-яЯёЁ.?!]" Then
             st = st & Mid(s, i, 1)
        End If
    Next i
    st = Replace(Replace(st, "!", "."), "?", ".") 'тут немного коряво
    Do While InStr(1, st, "..")
             st = Replace(st, "..", ".")
    Loop
    LetAndDot = st
End Function
 
Function Tbl(ByVal s As String) As Integer
    Dim n As Integer, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 3) = vbCrLf & " " Then
             n = n + 1
        End If
    Next i
    Tbl = n + 1
End Function
                        