Есть ли такая программа подсчёта

Пишется простой скрипт на любом языке программирования.
Если без скрипта, то по одному контексту можно подсчитать автоматически в Notepad++

Exel
https://support.office.com/ru-ru/article/Подсчет-количества-уникальных-значений-среди-повторяющихся-8d9a69b3-b867-490e-82e0-a929fbc1e273

эксель епта

на шаблон макроса)
Sub FindTables()

Dim tTable As Table
Open "F:\test.txt" For Append As #1
linew = ""
For Each tTable In ActiveDocument.Tables

tTable.Cell(1, 1).Select
stext = Selection.Text

If (Mid(stext, 1, 3) = "Имя") Then 'ищет таблицу с первым столбцом Имя. (в документе много таблиц, надо пройтись по всем такого образца)

Selection.MoveUp Count:=2
Selection.MoveRight Count:=1

With Selection.Find
.Text = ""
.Font.Bold = True
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute 'после этого вырезается имя "Сергей" (расположено чуть выше таблицы)

Selection.Copy
Selection.MoveLeft Count:=30
Selection.MoveDown Count:=2
Selection.InsertColumns
tTable.Rows(1).Delete 'удаляем 1 строку таблицы
tTable.Columns(1).Select
rw = tTable.Rows.Count
Selection.Paste 'вставляем имя Сергей в добавленный столбец
Selection.ClearFormatting 'убираем форматирование (имя жирным цветом идет)
tTable.ConvertToText Separator:=wdSeparateByTabs 'убираем границы таблицы

Selection.MoveStart wdLine, 0

For i = 1 To rw 'построчно записываем в тхт файл полученную таблицу
Selection.MoveEnd wdLine, 1
linew = linew + Selection.Text

Print #1, Selection.Text
Selection.EndOf
Next i

End If

'Print #1, linew
Next

Close #1
End Sub

Уроки программирования по Excel клёвые могу посоветовать вот тут на ютубе канал
https://www.youtube.com/channel/UCDd2VbwgxtsXtDGGWYY7vEQ