Старт_программы = Now

    'отключаем обновление - дёргание экрана при выполнении кода
    Application.ScreenUpdating = False
    'спустится вниз документа
    Selection.EndKey Unit:=wdStory
   
    'объявление переменной типа "Строка", размер 1 байт на символ, от 0 до 2 миллиардов
        'инициализация переменной ...
    Первое_слово = ""

    Dim Первое_слово1 As String
    'инициализация переменной ...
    Первое_слово1 = ""

    'инициализация переменной ...
    TextError = ""

    'если таблица обычная из одного столбца, тогда вместо
    'Dim q As Row
    'указываем
    'Dim q As Cell
    Dim q As Cell
    
    Таблица_номер = 1
    
    'Количество_строк_в_таблице = .Rows.Count

        Dim Счётчик As Byte
    
Обрабатываем_таблицы_дальше:

    With ActiveDocument.Tables(Таблица_номер)
        
        'последовательный проход по коллекции итератором быстрее, чем обращение к произвольному элементу по индексу
        'For x In — переменная x называется итератором, объектом, в котором содержится ссылка на очередной элемент коллекции/массива
        'For x = — переменная x называется индексом, порядковым номером произволного элемента коллекции/массива

        For Each q In .Range.Cells
            'For Each q In .Rows
            'For Each q In ActiveDocument.Tables(Таблица_номер).Rows(q).Cells(1)

            s1 = Trim$(q.Range)

            'If Len(s1) = 0 Then
            '.Rows(1).Select
            'MsgBox$ _
             "Начато: " & Старт_программы & vbCrLf & _
             "Закончено: " & Конец_программы & vbCrLf & _
             "Количество минут, затраченных на выполнение программы: " & DateDiff("n", Старт_программы, Конец_программы) & " В строке количество символов = 0"
            'Exit Sub
            'End If

            If s1 Like "*98*" Then GoTo Конец_цикла

            'считает от 0
            Первое_слово = Trim$(Split(s1, ",")(0))

            Первое_слово1 = "в" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If

            Первое_слово1 = "вз" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "во" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "вс" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "вы" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "до" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "за" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "из" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "ис" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "на" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "недо" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "о" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "об" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "обез" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "обес" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "ото" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "от" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "пере" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "по" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "под" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "подо" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "пре" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "при" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "раз" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "разо" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "с" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "со" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = "у" & Первое_слово
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = Первое_слово & "ся"
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            Первое_слово1 = Первое_слово & "сь"
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            
            'без окончания "сь"
            If Right$(Первое_слово, 2) = "сь" Then
             Первое_слово1 = Left$(Первое_слово, (Len(Первое_слово) - 2))
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            End If
            
            'без окончания "ся"
            If Right$(Первое_слово, 2) = "ся" Then
             Первое_слово1 = Left$(Первое_слово, (Len(Первое_слово) - 2))
            'проверка орфографии слова
            If Application.CheckSpelling(Первое_слово1) Then
                'проверка повторяемости слова
                With ActiveDocument.Range.Find
                    .Text = "<" & Первое_слово1 & ","    'поиск в начале слова
                    .Wrap = wdFindStop    'поиск остановить, остановит поиск по достижении конца
                    .MatchWildcards = True    'эта опция отвечает за поиск с использованием подстановочных знаков, не работает когда установлено в положение False, или её нет вообще, если установлена в положение True, тогда работает
                    Счётчик = 0
                    Do While .Execute = True
                        '.Parent.Select 'выделит искомые слова
                        Счётчик = Счётчик + 1
                    Loop
                End With
                If Счётчик = 0 Then Selection.TypeText Text:=Первое_слово1 & ", " & Первое_слово1 & vbCrLf
            End If
            End If
            
Конец_цикла:

        Next q
        
        If Таблица_номер < 4 Then Таблица_номер = Таблица_номер + 1: GoTo Обрабатываем_таблицы_дальше
        
        Конец_программы = Now

        'interval argument "n" - Minute
        MsgBox$ _
                "Начато: " & Старт_программы & vbCrLf & _
                           "Закончено: " & Конец_программы & vbCrLf & _
                           "Количество минут, затраченных на выполнение программы: " & DateDiff("n", Старт_программы, Конец_программы), _
                           vbOKOnly, "Внимание, работа программы по поиску новых глаголов завершена"

        'конец With ActiveDocument.Tables(Таблица_номер)
    End With

    'отменяем отключенное ранее обновление - дёргание экрана при выполнении кода
    Application.ScreenUpdating = True