Sub FillValueForLetter(letter As Integer, value As Integer)
    Dim index As Integer

    ' Вычисляем индекс столбца при помощи формулы
    index = letter - Asc("А") + 1

    ' Вписываем букву, соответствующую коду letter
    Worksheets("Лист2").Cells(1, index) = Chr(letter)

    ' Вписываем число найденных слов
    Worksheets("Лист2").Cells(2, index) = value
End Sub
Function WordStartsWithLetter(letter As Integer, word As String) As Integer
    Dim startsWithLetter As String

    ' Выделяем первую букву
    startsWithLetter = Left(word, 1)

    ' Приводим букву к верхнему регистру (a -> A, A -> A)
    startsWithLetter = UCase(startsWithLetter)

    ' Сравниваем код буквы с letter
    If (Asc(startsWithLetter) = letter) Then
        WordStartsWithLetter = 1
    Else
        WordStartsWithLetter = 0
    End If
End Function
Function CountWordsInCell(letter As Integer, cell As range) As Integer
    Dim words() As String
    Dim i As Integer
    Dim counter As Integer

    ' Разбиваем текст ячейки на слова,
    words = Split(cell.text, " ")

    ' Пробегаем по всем словам
    For i = LBound(words) To UBound(words)

        ' Увеличиваем счетчик на единицу, если слово начинается с буквы letter
        counter = counter + WordStartsWithLetter(letter, words(i))
    Next i
    CountWordsInCell = counter
End Function
Function CountWordsInCells(letter As Integer) As Integer
    Dim numberOfRows, numberOfColumns, counter, row, column As Integer
    numberOfRows = 33
    numberOfColumns = 3
    counter = 0

    ' В каждой строке с 1 до 33
    For row = 1 To numberOfRows
        ' В каждом столбце с 1 до 3
        For column = 1 To numberOfColumns
            Dim subcounter As Integer

            ' Вычисляем число слов, начинающихся на букву letter, в строке row, столбце column
            subcounter = CountWordsInCell(letter, Worksheets("Лист1").Cells(row, column))

            ' Увеличиваем счетчик найденных слов на
            counter = counter + subcounter
        Next column
    Next row

    CountWordsInCells = counter
End Function
Sub BuildTable()
    Dim letter As Integer

    ' Для каждой буквы от А до Я
    For letter = Asc("А") To Asc("Я")
        Dim counter As Integer

        ' Подсчитываем число слов во всех ячейках, начинающихся на эту букву
        counter = CountWordsInCells(letter)

        ' Выводим результат на второй лист
        Call FillValueForLetter(letter, counter)
    Next letter
End Sub
Sub BuildChart()
    ActiveSheet.Shapes.AddChart.Select
        With ActiveChart
            .ChartType = xlColumnClustered
            .SetSourceData Source:=range("Лист2!$A$1:$AF$2")
            .HasTitle = True
            .ChartTitle.text = "Частоты первых букв в словах"
        End With
End Sub
Sub Task3()
    Call BuildTable
    Call BuildChart
End Sub