Оптимизировать обработку таблицы Ворда

[Ципихович Эндрю]

Здравствуйте, подскажите что можно предпринять, таблицу за 12 часов обрабатывает только 6000 строк, ужас
делов то узнать в таблице чтобы.... указано в тексте TextError, код:

For q = 1 To Количество_строк_в_таблице

            s1 = Trim$(.Rows(q).Range)

            Курсив = .Rows(q).Range.Font.Italic
         
                      If .Rows(q).Range.HighlightColorIndex = wdYellow _
               And s1 Like "*[её]*" = False Then TextError = "В строке имеется выделение жёлтым цветом, но не имеется буквы ""её""": GoTo Выход_из_цикла
           
            If Курсив = -1 And s1 Like "*[её]*" = False Then TextError = "В строке имеется курсив, но не имеется буквы ""её""": GoTo Выход_из_цикла

                     If .Rows(q).Range.HighlightColorIndex <> wdYellow _
               And Курсив = -1 Then TextError = "В строке имеется курсив, но она не выделена жёлтым цветом": GoTo Выход_из_цикла

                      If Курсив = -1 _
               And .Rows(q).Range.HighlightColorIndex <> wdYellow Then TextError = "В строке имеется курсив, но она не выделена жёлтым цветом": GoTo Выход_из_цикла

            ''''парность строк
         
            If .Rows(q).Range.HighlightColorIndex = wdYellow _
               Or Курсив = -1 Then Парность_строки = Парность_строки + 1

                       If Парность_строки Mod 2 <> 0 Then

                               If .Rows(q).Range.HighlightColorIndex = wdYellow _
                   And .Rows(q + 1).Range.HighlightColorIndex <> wdYellow Then TextError = "В строке имеется выделение жёлтым цветом, но в следующая строке нет выделения жёлтым цветом": GoTo Выход_из_цикла

                               If Курсив = -1 _
                   And .Rows(q + 1).Range.Font.Italic <> -1 Then TextError = "В строке имеется курсив, но в следующей строке не имеется курсива": GoTo Выход_из_цикла
            End If

        Next q

Спасибо

[shanemac51]

перейдя на цикл for each время уменьшается в 3 раза
(на моем компе с 140 мин до 45)

Sub wr130205_0919()
Dim q, q1, s1, TextError, Количество_строк_в_таблице, Курсив, Парность_строки
Dim dt1, dt2
Dim r As Row
With Word.ActiveDocument.Tables(1)
Количество_строк_в_таблице = 6000
'Word.ActiveDocument.Tables(1).Rows.Count
dt1 = Now
q1 = 0
For Each r In .Rows
q1 = q1 + 1
q = q1

s1 = Trim$(r.Range)

Debug.Print q1; (DateDiff("s", Now(), dt1) / q1) * 6000 / 60



Курсив = r.Range.Font.Italic

If r.Range.HighlightColorIndex = wdYellow And s1 Like "*[её]*" = False Then
TextError = "В строке имеется выделение жёлтым цветом, но не имеется буквы ""её"""
GoTo Выход_из_цикла
End If

If Курсив = -1 And s1 Like "*[её]*" = False Then
TextError = "В строке имеется курсив, но не имеется буквы ""её"""
GoTo Выход_из_цикла
End If

If r.Range.HighlightColorIndex <> wdYellow And Курсив = -1 Then
TextError = "В строке имеется курсив, но она не выделена жёлтым цветом"
GoTo Выход_из_цикла
End If

If Курсив = -1 And r.Range.HighlightColorIndex <> wdYellow Then
TextError = "В строке имеется курсив, но она не выделена жёлтым цветом"
GoTo Выход_из_цикла
End If
''''парность строк

If r.Range.HighlightColorIndex = wdYellow Or Курсив = -1 Then
Парность_строки = Парность_строки + 1
End If
If Парность_строки Mod 2 <> 0 Then

If r.Range.HighlightColorIndex = wdYellow And .Rows(q + 1).Range.HighlightColorIndex <> wdYellow Then
TextError = "В строке имеется выделение жёлтым цветом, но в следующая строке нет выделения жёлтым цветом"
GoTo Выход_из_цикла
End If

If Курсив = -1 And .Rows(q + 1).Range.Font.Italic <> -1 Then
TextError = "В строке имеется курсив, но в следующей строке не имеется курсива"
GoTo Выход_из_цикла
End If
End If

Next r
End With
Выход_из_цикла:
Debug.Print q, TextError
End Sub

[Ципихович Эндрю]

спасибо, я выкладывал часть кода... без объявлений...., они у меня объявлены
и так я понял что мне нужно, дообъявить
Dim r As Row
и изменить на For Each r In .Rows
и это спасёт меня...???
вариации с расчётом времени мне не нужны

[Ципихович Эндрю]

увидел, что .Rows(q). тоже долой, понял...

[Скрипт]

Ципихович Эндрю, напишите словесное описание вашей задачи. Если словами будет сложно объяснить, то выложите Word-документ с примерными данными и на основе этого документа поясните, какой должен быть результат.


Примечание

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

[Ципихович Эндрю]

всё просто, нужно узнать чтобы не было ошибок, а именно
Нужно узнать, что в строках таблицы
"В строке имеется выделение жёлтым цветом, но не имеется буквы ""её"""
"В строке имеется курсив, но не имеется буквы ""её"""
"В строке имеется курсив, но она не выделена жёлтым цветом"
"В строке имеется курсив, но она не выделена жёлтым цветом"
"В строке имеется выделение жёлтым цветом, но в следующей строке нет выделения жёлтым цветом"
"В строке имеется курсив, но в следующей строке не имеется курсива"

[Ципихович Эндрю]

пока весь код такой

Private Sub CommandButton8_Click()
'поиск чётности строк с курсивом и выделением жёлтым цветом

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

    'отключаем обновление - дёргание экрана при выполнении кода
    Application.ScreenUpdating = False
    'объявление переменной типа "Длинный целый", размер 4 байта
    'от -2147483648 до 2147483647
    'то есть до 2 миллиардов 147 миллионов 483 тысячи 647
    'то есть до 2.147.483.647
    Dim Количество_строк_в_таблице As Long
    Dim Парность_строки As Long
    Dim Курсив As Long
    Dim w As Long
    'можно не указывать ... = 0
    
    Dim q As Row

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

    With ActiveDocument.Tables(1)

        Количество_строк_в_таблице = .Rows.Count

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

        For Each g In .Rows
            
            s1 = Trim$(g.Range)
            w1 = w1 + 1
            Курсив = g.Range.Font.Italic
            'g.Range.Font.Italic = 0 - нет курсива в строке
            'g.Range.Font.Italic = -1 - курсив в строке
            'g.Range.Font.Italic = 9999999 - а строке смешан курсив и не курсив

            'условие о том выделено ли жёлтым цветом в строке, надо чтобы строка была выделена полностью, а не частично жёлтым цветом
            If g.Range.HighlightColorIndex = wdYellow _
               And s1 Like "*[её]*" = False Then TextError = "В строке имеется выделение жёлтым цветом, но не имеется буквы ""её""": GoTo Выход_из_цикла

            'условие о том курсив ли в строке
            If Курсив = -1 _
               And s1 Like "*[её]*" = False Then TextError = "В строке имеется курсив, но не имеется буквы ""её""": GoTo Выход_из_цикла

            'условие о том выделено ли жёлтым цветом в строке, надо чтобы строка была выделена полностью, а не частично жёлтым цветом
            If g.Range.HighlightColorIndex <> wdYellow _
               And Курсив = -1 Then TextError = "В строке имеется курсив, но она не выделена жёлтым цветом": GoTo Выход_из_цикла

            'условие о том курсив ли в строке
            If Курсив = -1 _
               And g.Range.HighlightColorIndex <> wdYellow Then TextError = "В строке имеется курсив, но она не выделена жёлтым цветом": GoTo Выход_из_цикла

            ''''парность строк

            'условие о том выделено ли жёлтым цветом в строке, надо чтобы строка была выделена полностью, а не частично жёлтым цветом
            'условие о том курсив ли в строке
            If g.Range.HighlightColorIndex = wdYellow _
               Or Курсив = -1 Then Парность_строки = Парность_строки + 1

            'Mod это остаток
            If Парность_строки Mod 2 <> 0 Then

                'условие о том выделено ли жёлтым цветом в строке, надо чтобы строка была выделена полностью, а не частично жёлтым цветом
                If g.Range.HighlightColorIndex = wdYellow _
                   And .Rows(w + 1).Range.HighlightColorIndex <> wdYellow Then TextError = "В строке имеется выделение жёлтым цветом, но в следующей строке нет выделения жёлтым цветом": GoTo Выход_из_цикла

                'условие о том курсив ли в строке
                If Курсив = -1 _
                   And .Rows(w + 1).Range.Font.Italic <> -1 Then TextError = "В строке имеется курсив, но в следующей строке не имеется курсива": GoTo Выход_из_цикла
            End If

        Next g

Выход_из_цикла:

        Конец_программы = Now

        If Len(TextError) <> 0 Then
            g.Select
            'interval argument "n" - Minute
            MsgBox$ _
                    "Начато: " & Старт_программы & vbCrLf & _
                               "Закончено: " & Конец_программы & vbCrLf & _
                               "Количество минут, затраченных на выполнение программы: " & DateDiff("n", Старт_программы, Конец_программы) & vbCrLf & _
                               TextError, _
                               vbOKOnly, "Внимание"

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

        'конец With ActiveDocument.Tables(1)
    End With

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

End Sub

[shanemac51]

не помешало бы заменить на переменные

yell=(g.Range.HighlightColorIndex = wdYellow)
eeee=(s1 Like "*[её]*")
......
If yell = true    And eeee = False Then TextError ................

уменьшит время раза в 2

[Скрипт]

Ципихович Эндрю: "В строке имеется выделение жёлтым цветом, но не имеется буквы ""её"""

в Word-документе прямо так и встречается ""её""" - буква е, за ней буква ё и две эти буквы окружены пятью кавычками?

[Вождь]

Сообщение от Ципихович Эндрю

...Нужно узнать, что в строках таблицы...имеется выделение...курсив...в следующей строке...

Быстрее будет, если искать все это обычным поиском (Find).

Можно преобразовать таблицу в текст, обработать, потом обратно. Судя по коду, объединенных ячеек нет. Если сама таблица не имеет сложного форматирования, то вариант стоящий.