1

Тема: Поиск в тексте включая таблицы - проблемы и !решение

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

    Dim MyRange, oRange As Range
    Dim MyRangeEnd As Long
    Dim strAcronym As String

    Set MyRange = ActiveDocument.Range
    MyRangeEnd = MyRange.End
    strListSep = Application.International(wdListSeparator)

    Set oRange = MyRange

        With oRange.Find
            .Text = "<[A-ZА-ЯЁ]{2" & strListSep & "}>"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = True
            .MatchWildcards = True
            
            'Perform the search
            Do While .Execute
                'Continue while found
                strAcronym = oRange
                
                ' VERY IMPORTANT line as for some docs Search gets stuck in headers/footers etc.
                If strAcronym = "" Then oRange.Start = oRange.Start + 1
                
                Debug.Print oRange.Start, "Table=" & Selection.Information(wdWithInTable), strAcronym

                '***********************************************************************
                'Манипуляции с найденным
                oRange.Expand Unit:=wdSentence
                Debug.Print strAcronym, oRange 'печать сокр. и предложения где оно найдено

                '***********************************************************************
                
                If oRange.Information(wdWithInTable) = True Then
                    oRange.MoveEnd wdCharacter, -1
                Else
                    oRange.Start = oRange.End
                    oRange.End = MyRangeEnd
                End If

            Loop

раскопал следующее:
внешняя ссылка
If the end of the range includes the cell marker, then the range includes the whole cell regardless of where you set the start value.
А именно - если диапазон включает маркер конца ячейки, то диапазон расширяется на ВСЮ ячейку, независимо от того, какое задано значение Start

Не знаю как это связано, но именно взяв из указанного примера подход oRange.MoveEnd wdCharacter, -1
удалось добится работоспособности кода как в основном тексте, так и в таблицах. Да, еще и колонтитулы проскакивает.

В общем, дополнения исправления и т.д. приветствуются. Так, например я расширяю диапазон на  oRange.Expand Unit:=wdSentence - если кто предложит как по другому получить на этот же диапазон ссылку без расширения oRange было бы лучше, а то там по моему опасению запрятан потенциальный глюк.

З.Ы.
Если соберусь - выложу потом еще код поиска ссылок типа (ХХ-)XXX-XX-XXXX-XXXXXX - госты, осты и др. стандарты... в работе...

Отредактировано VBA-addict (24.11.2010 11:17:54)

Делай, что можешь, и будь, что будет!

2

Re: Поиск в тексте включая таблицы - проблемы и !решение

По стандартам было бы интересно посмотреть и потестировать.. У самого некоторые задумки тоже есть по этому поводу:)
Мой механизм в макросе по поиску аббревиатур не смотрели? может что полезное для себя найдете??? Лежит в готовых решениях..

Отредактировано andrkar (23.11.2010 20:45:40)

3

Re: Поиск в тексте включая таблицы - проблемы и !решение

Ваш код ищет только первый акроним в предложении. Так и задумано?

Чтобы не было зацикливаний, всегда продолжайте поиск с конца найденного текста. Если все же изменяете область, то не переходите за знак абзаца.

Попробуйте так:

    Dim strSentence As String

                With oRange.Duplicate
                    .Expand Unit:=wdSentence
                    strSentence = .Text
                End With
                Debug.Print strAcronym, strSentence
                
                oRange.Collapse Direction:=Word.wdCollapseEnd
Макросы под заказ и готовый пакет - mtdmacro.ru

4

Re: Поиск в тексте включая таблицы - проблемы и !решение

Вождь пишет:

With oRange.Duplicate
      .Expand Unit:=wdSentence
      strSentence = .Text
End With

Вождь, спасибо!!! То, что доктор прописал smile

Вождь пишет:

oRange.Collapse Direction:=Word.wdCollapseEnd

Это кому как smile Мне не подходит, т.к. моя задумка шире - не приведена здесь smile MyRange - в зависимости от ситуации принимает разные значения - По умолчанию - весь документ, при зажатом Ctrl c текущего места и до конца, при зажатом Shift - только в выделении 

Интересующимся поправленный вариант:

    Dim MyRange, oRange As Range
    Dim MyRangeEnd As Long
    Dim strAcronym As String

    Set MyRange = ActiveDocument.Range
    MyRangeEnd = MyRange.End
    strListSep = Application.International(wdListSeparator)

    Set oRange = MyRange

        With oRange.Find
            .Text = "<[A-ZА-ЯЁ]{2" & strListSep & "}>"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = True
            .MatchWildcards = True
            
            'Perform the search
            Do While .Execute
                'Continue while found
                strAcronym = oRange
                
                ' VERY IMPORTANT line as for some docs Search gets stuck in headers/footers etc.
                If strAcronym = "" Then oRange.Start = oRange.Start + 1
                
                Debug.Print oRange.Start, "Table=" & Selection.Information(wdWithInTable), strAcronym

                '***********************************************************************
                'Манипуляции с найденным
                With oRange.Duplicate
                       .Expand Unit:=wdSentence
                       strSentence = Trim(Replace(.Text, vbCr, ""))
                End With
                Debug.Print strAcronym, strSentence 'печать сокр. и предложения где оно найдено

                '***********************************************************************
                
                If oRange.Information(wdWithInTable) = True Then
                    oRange.MoveEnd wdCharacter, -1
                Else
                    oRange.Start = oRange.End
                    oRange.End = MyRangeEnd
                End If

            Loop

        End With
Делай, что можешь, и будь, что будет!

5

Re: Поиск в тексте включая таблицы - проблемы и !решение

С полным кодом все стало ясно. Во народ скрытный пошел smile

Надо менять алгоритм, иначе будет и дальше в таблицах зацыкливатся. Для ясности, поместите курсор в середине таблицы и запустите код:

Dim R As Range

    Set R = Selection.Range
    R.End = R.StoryLength
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = False
        .Text = "^?"
    End With
    R.Find.Execute
    R.Select

Искать надо не в заданной области, а просто вперед проверяя попадание результата в область поиска. Где-то так:

Dim RWork As Range
Dim RFind As Range

    Set RFind = RWork.Duplicate
    With RFind.Find
        '...
        .Wrap = wdFindStop
    End With
    RFind.Collapse wdCollapseStart
    Do While RFind.Find.Execute
        If RFind.End > RWork.End Then Exit Do
        '...
        RFind.Collapse wdCollapseEnd
    Loop
Макросы под заказ и готовый пакет - mtdmacro.ru

6

Re: Поиск в тексте включая таблицы - проблемы и !решение

Вождь пишет:

Для ясности, поместите курсор в середине таблицы и запустите код:

Поместил, запустил - заданый код выделяет первый символ первой ячейки текущей строки таблицы - но ясности это мне не добавило smile Запустил в таблице со объединенными ячейками - выделяет самую левую необъединенную ячейку после 1 объединенной. В общем - неясно.

Второй пример кода тоже не вразумил
Понял, что:
1) Поиск осуществляется по дубликату Range RWork
2) Поиск запускается с начала диапазона RWork RFind.Collapse wdCollapseStart ?
3) В цикле проверяется не заскочил ли RFind за RWork.End - если да, то завершается работа
Не понял главное - зачем так?
Duplicate, видимо, чтобы невозможно было что-то поменять, т.к. он Read only - ОК
А вот зачем проверять заскок - если определена работа до конца диапазона... непонятно...

Отредактировано VBA-addict (24.11.2010 13:50:06)

Делай, что можешь, и будь, что будет!

7

Re: Поиск в тексте включая таблицы - проблемы и !решение

Первый мой код наглядно иллюстрирует алгоритм работы Вашего кода. Т.е. зацикливание, когда поиск в заданной области, а начало этой области в таблице.

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

Макросы под заказ и готовый пакет - mtdmacro.ru

8

Re: Поиск в тексте включая таблицы - проблемы и !решение

Вождь пишет:

R.Find.Execute
R.Select

На мой скромный взгляд не является полным док-вом зацикливания в табл.

если заменить на:

    For i = 1 To 250
        R.Find.Execute
        R.Select
        Selection.Font.Bold = True
    Next

то видно, что все замечательно идет по/выходит из таблицы

Вопрос в том, что начало для диапазона поиска в таблице действительно берется не совсем корректно в случае выделения. Тут согласен.

Т.о. для заинтересовавшихся

Приведенный мной выше код будет работать некорректно, в случае отнесения oRange на кусок выделенный внутри таблицы. Необходима доп. адаптация для определения позиции курсора внутри ячейки таблицы и т.п.

Единственное, что на данный момент у меня для такой точности необходимости нет - все таблицы в моем случае шерстятся целиком

Отредактировано VBA-addict (24.11.2010 18:19:22)

Делай, что можешь, и будь, что будет!

9

Re: Поиск в тексте включая таблицы - проблемы и !решение

Ну как же? В моем примере зацикливания, поиск запускается в области от курсора до конца документа, а находит вообще за этой областью. Ведь сами же пробовали:

VBA-addict пишет:

…запустил - заданный код выделяет первый символ первой ячейки текущей строки таблицы…

А должен быть найден первый символ за курсором!

VBA-addict пишет:

…все таблицы в моем случае шерстятся целиком…

Используется другой макрос? Если нет, то зацикливания не избежать. Для полной ясности доработал мой демонстратор циклом и выделением найденного красным:

Dim R As Range

    Set R = Selection.Range
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = False
        .Text = "^?"
    End With
    Do While R.End < R.StoryLength - 1
        R.Collapse wdCollapseEnd
        R.End = R.StoryLength
        R.Find.Execute
        If R.Find.Found <> True Then Exit Sub
        R.HighlightColorIndex = wdRed
    Loop

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

Макросы под заказ и готовый пакет - mtdmacro.ru

10

Re: Поиск в тексте включая таблицы - проблемы и !решение

Вождь пишет:

Попробуйте, поместив курсор перед таблицей

Попробовал ваш макро - 2 варианта:
1) Начал выделение перед таблицей и закончил в середине ее - циклится в следующей за выделением 1 ячейке таблицы.
2) Просто поставил курсор - циклится в 1 ячейке таблицы

Подумал....
Погонял свой макрос => обобщение - если работа будет запускаться в выделении, начинающемся или заканчивающемся в середине таблицы - все наглухо умрет

Т.о. согласен - нужно контроллировать

Вождь пишет:

    Do While RFind.Find.Execute
        If RFind.End > RWork.End Then Exit Do
        '...
        RFind.Collapse wdCollapseEnd
    Loop

единственное переписал короче - по идее должно работать также

Do While RFind.Find.Execute and RFind.End <= RWork.End
    ...
Loop

Остался пока открытым вопрос начала выделения в таблице... и корректной работы с ним поиска... Обдумываю

В общем, таблицы - СОВСЕМ отдельная песня
счас выделил в  таблице 5х3 три средних ячейки... оказалось, что при этом Range возвращает
не выделенные ячейки (2,2),(3,2),(4,2), а (2,2),(2,3),(3,1),(3,2),(3,3),(4,1),(4,2)

Т.о. выделение в таблице нужно обрабатывать СОВСЕМ иначе.

поскольку мне не настолько это все нужно и в моем случае выделение никогда не будет начинаться в таблице - дальнейшую проработку пока делать не буду

окончательный код (с контролем вылета поиска за окончание выделения в таблице)

    Dim MyRange, oRange As Range
    Dim MyRangeEnd As Long
    Dim strAcronym As String

    Set MyRange = ActiveDocument.Range
    MyRangeEnd = MyRange.End
    strListSep = Application.International(wdListSeparator)

    Set oRange = MyRange

        With oRange.Find
            .Text = "<[A-ZА-ЯЁ]{2" & strListSep & "}>"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = True
            .MatchWildcards = True
            
            'Perform the search
            Do While .Execute And oRange.End <= MyRangeEnd
                'Continue while found
                strAcronym = oRange
                
                ' VERY IMPORTANT line as for some docs Search gets stuck in headers/footers etc.
                If strAcronym = "" Then oRange.Start = oRange.Start + 1
                
                Debug.Print oRange.Start, "Table=" & Selection.Information(wdWithInTable), strAcronym

                '***********************************************************************
                'Манипуляции с найденным
                With oRange.Duplicate
                       .Expand Unit:=wdSentence
                       strSentence = Trim(Replace(.Text, vbCr, ""))
                End With
                Debug.Print strAcronym, strSentence 'печать сокр. и предложения где оно найдено

                '***********************************************************************
                
                If oRange.Information(wdWithInTable) = True Then
                    oRange.MoveEnd wdCharacter, -1
                Else
                    oRange.Start = oRange.End
                    oRange.End = MyRangeEnd
                End If

            Loop

        End With

Отредактировано VBA-addict (25.11.2010 12:12:55)

Делай, что можешь, и будь, что будет!

11

Re: Поиск в тексте включая таблицы - проблемы и !решение

Ох, тяжко мне smile Добавление проверок не спасет Ваш макрос. Менять надо принцип.

Похоже, нет понимания различия между поиском в заданной области (Range.Start < Range.End) и поиском когда область схлопнута (Range.Start = Range.End), т.е. во всем документе.

В Вашем макросе нет разницы, где начинается область поиска, главное - где находятся искомые акронимы. Ведь область поиска макрос меняет каждый раз после успешного поиска. В начале это MyRange, затем - от конца акронима до конца MyRange. Т.е. как только находится акроним в таблице, то оставшаяся область поиска будет начинаться в таблице и произойдет зацикливание.

По поводу области в таблице. Невозможно работать с областью: стока таблицы + ячейка таблицы. Как только в область попадает несколько строк таблицы, началом области будет начало строки таблицы. Из-за этого все беды с зацикливанием.

Макросы под заказ и готовый пакет - mtdmacro.ru

12

Re: Поиск в тексте включая таблицы - проблемы и !решение

Непоняток много - я до этого, в основном имел дело с Excel и Access smile Так что Word со своей моделью для меня животинка новая...

Итак попробуем подвести итоги:

1)

Вождь пишет:

Искать надо не в заданной области, а просто вперед проверяя попадание результата в область поиска.

Т.е. достаточно

Do While RFind.Find.Execute and RFind.End <= RWork.End
    ...
Loop

а все мои проверки в конце не нужны...?
Вместо них достаточно добавить

    RFind.Collapse wdCollapseStart
...
    RFind.Collapse wdCollapseEnd

2) Не понимаю:
2.1 В начале поиска oRange ссылается на некий текст в котором ищутся аббревиатуры
2.2. В момент, когд аббревиатура находится этот же oRange ссылается на найденную фразу
2.3. Не смотря на это после последующего выполнения .Execute oRange перемещается к другому найденному тексту
Непонятно - где же все-таки хранятся:
1) Начало и конец изначального oRange - иначе бы не действовало .Collapse
2) Маркер текущего положения курсора внутри oRange - иначе как бы возобновлялся поиск...

Отредактировано VBA-addict (25.11.2010 17:11:01)

Делай, что можешь, и будь, что будет!

13

Re: Поиск в тексте включая таблицы - проблемы и !решение

Нашел еще вариант

После определения MyRange в моем случае

Set myRgOrig = myRange.Duplicate
    ...
Do While .Execute And oRange.InRange(myRgOrig)
    ...
Loop
...

т.е. проверяется вхождение найденного интервала в исходный диапазон, который в Duplicate остается неизменным

Делай, что можешь, и будь, что будет!