1

Тема: Range.Find VBA

Доброго времени суток, уважаемые форумчане. Новый вопрос из разряда невероятного:
Какая есть возможность совершить поиск в определённой области документа? Лучше всего от одного абзаца до другого. Что-то у меня с абзацами ничего не вышло и я решил попробовать "от символа до символа". Но проблема в том, что есть уйма разнообразных полей. Казалось бы, всё просто - индексы символов нашёл через Len(от начала документа до места курсора(который становится в выделяемый параграф)). От Len1 До Len2 - вот тебе и область, но по итогу область смещается и текст в эту область попадает не совсем тот. Подскажите как с этим бороться?  (при отображении полей выяснять Len тоже пробовал - не помогает - область всё равно остаётся смещённой, хоть и в меньшей степени)

Вот так ищу первый символ

For Each pPara In ActiveDocument.Paragraphs
    If Left(pPara.Range.Text, Len("Мой текст")) = "Мой текст" Then
        pPara.Range.Select
        iStartSymbol = Len(ActiveDocument.Range(1, Selection.Start))
iNumber = ActiveDocument.Range(1, Selection.Start).Paragraphs.Count
        GoTo Line0
    End If

Вот так второй

For iCount = iNumber To ActiveDocument.Paragraphs.Count
        If ActiveDocument.Paragraphs(iCount).Next.Style = ActiveDocument.Styles("Мой стиль") Then
            ActiveDocument.Paragraphs(iCount).Range.Select
            iEndSymbol = Len(ActiveDocument.Range(1, Selection.Start))
            GoTo Line1
        End If
    Next iCount

Но получается ерунда полнейшая.

2

Re: Range.Find VBA

Извините за беспокойство - уже сам разобрался. Достаточно было внимательно почитать о возможностях объекта Range. Очень полезная возможность - создание собственной области через

SetRange

.

3

Re: Range.Find VBA

Fck_This пишет:

Какая есть возможность совершить поиск в определённой области документа?

Вы можете выполнять поиск по диапазону с помощью как раз метода Range.Find. В примере привожу поиск по стилю (стартовая программа - SearchByStyleInRange, она в процессе цикла поиска вызывает подпрограмму RangeStartEndOfStyleInRange. Подпрограмма возвращает границы диапазона найденного текста (или -1, если текст не найден).  Закладка на найденном тексте создается на случай необходимости чтения или изменения найденного текста - тогда его можно найти по диапазону этой закладки.

Sub SearchByStyleInRange()
Dim sr As range
Dim ok_to_search As Boolean
Dim search_style_name As String
Dim search_style As Style
Dim ss_start As Long
Dim ss_end As Long
Dim text_found As String
Dim search_found_bookmark_name As String
Set sr = ActiveDocument.range
search_style_name = "DFN" 'find text in this style
ok_to_search = True
On Error Resume Next
Set search_style = ActiveDocument.Styles(search_style_name)
On Error GoTo 0
search_found_bookmark_name = "SearchFoundBookmark" 'bookmark for the text found
If Not (search_style Is Nothing) Then
    While ok_to_search
        'Search by style
        RangeStartEndOfStyleInRange sr, search_style, ss_start, ss_end
        If ss_start = -1 Then 'text not found = stop the search
            ok_to_search = False
        Else 'text is found
            'set bookmark
            If ActiveDocument.Bookmarks.Exists(search_found_bookmark_name) Then
                ActiveDocument.Bookmarks(search_found_bookmark_name).Delete
            End If
            ActiveDocument.Bookmarks.add range:=sr, name:=search_found_bookmark_name
            'process the found text
            text_found = ActiveDocument.Bookmarks(search_found_bookmark_name).range.Text
            ' . . . .
        End If
    Wend
End If
End Sub

Sub RangeStartEndOfStyleInRange(ByRef rgf As range, ByRef st As Style, ByRef fst_start As Long, ByRef fst_end As Long)
'find text with style 'st' in the 'rgf' range.
'the found text boundaries are determined (for not found the -1;-1 values are returned).
fst_start = -1
fst_end = -1
With rgf.Find
    .ClearFormatting
    .Style = st
    .Forward = True
    .Format = True
    .Text = ""
    .Execute
End With
If rgf.Find.found = True Then
    fst_start = rgf.Start
    fst_end = rgf.End
End If
End Sub

4

Re: Range.Find VBA

yshindin пишет:
Fck_This пишет:

Какая есть возможность совершить поиск в определённой области документа?

Вы можете выполнять поиск по диапазону с помощью как раз метода Range.Find. В примере привожу поиск по стилю (стартовая программа - SearchByStyleInRange, она в процессе цикла поиска вызывает подпрограмму RangeStartEndOfStyleInRange. Подпрограмма возвращает границы диапазона найденного текста (или -1, если текст не найден).  Закладка на найденном тексте создается на случай необходимости чтения или изменения найденного текста - тогда его можно найти по диапазону этой закладки.

Sub SearchByStyleInRange()
Dim sr As range
Dim ok_to_search As Boolean
Dim search_style_name As String
Dim search_style As Style
Dim ss_start As Long
Dim ss_end As Long
Dim text_found As String
Dim search_found_bookmark_name As String
Set sr = ActiveDocument.range
search_style_name = "DFN" 'find text in this style
ok_to_search = True
On Error Resume Next
Set search_style = ActiveDocument.Styles(search_style_name)
On Error GoTo 0
search_found_bookmark_name = "SearchFoundBookmark" 'bookmark for the text found
If Not (search_style Is Nothing) Then
    While ok_to_search
        'Search by style
        RangeStartEndOfStyleInRange sr, search_style, ss_start, ss_end
        If ss_start = -1 Then 'text not found = stop the search
            ok_to_search = False
        Else 'text is found
            'set bookmark
            If ActiveDocument.Bookmarks.Exists(search_found_bookmark_name) Then
                ActiveDocument.Bookmarks(search_found_bookmark_name).Delete
            End If
            ActiveDocument.Bookmarks.add range:=sr, name:=search_found_bookmark_name
            'process the found text
            text_found = ActiveDocument.Bookmarks(search_found_bookmark_name).range.Text
            ' . . . .
        End If
    Wend
End If
End Sub

Sub RangeStartEndOfStyleInRange(ByRef rgf As range, ByRef st As Style, ByRef fst_start As Long, ByRef fst_end As Long)
'find text with style 'st' in the 'rgf' range.
'the found text boundaries are determined (for not found the -1;-1 values are returned).
fst_start = -1
fst_end = -1
With rgf.Find
    .ClearFormatting
    .Style = st
    .Forward = True
    .Format = True
    .Text = ""
    .Execute
End With
If rgf.Find.found = True Then
    fst_start = rgf.Start
    fst_end = rgf.End
End If
End Sub

Уважаемы, скажите, а это будет работать, если мне нужно найти все вхождения текста в области? Я делал поиск по области

OurRange.Find.Execute

с маской поиска

OurRange.Find.Text "anytext"

через цикл

Do while OurRange.Find.Execute = True

. И дело в том, что у меня несколько масок поиска, а макрос, когда обрабатывает первое выражение, OurRange делает равным маске поиска и это всё сбивает.

Вот полный кусок кода

    Set OurRange = ActiveDocument.Paragraphs(iNumberOne).Range
        OurRange.SetRange Start:=OurRange.Start, End:=ActiveDocument.Paragraphs(iNumberTwo).Range.End
'Устанавливаем свою область
    For i = 1 To 10
        x = 0
        With OurRange.Find
            .Text = FindArray(i)
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
                TextOne = OurRange
                TextTwo = Peremennaya
                MsgBox TextOne & TextTwo
'ПОиЗА будет выполняться, пока будут попадаться вхождения
                Do While Selection.Find.Execute = True
                Peremennaya = OurRange.Find.Parent
'Отсейка
'На данном этапе происходит очистка найденной переменной от (по порядку): Замена неразрывного дефиса Chr(30) на обычный Chr(150)
'Выпил точки с запятой "Chr(59)" _ запятой "Chr(44)" _ Открывающей скобки "Chr(40)" _ Знака абзаца "Chr(13)" _
'Неразрывный пробел Chr(160) будет изменён на обычный Chr(32) _ Справа будут удалены пробелы RTrim и точка Chr(46), если есть
                    If InStr(Peremennaya, Chr(30)) >= 1 Then
                        Peremennaya = Replace(Peremennaya, Chr(30), Chr(150))
                        End If
                    If InStr(Peremennaya, Chr(59)) >= 1 Then
                        Peremennaya = Replace(Peremennaya, Chr(59), ReplaceText)
                        End If
                    If InStr(Peremennaya, Chr(44)) >= 1 Then
                        Peremennaya = Replace(Peremennaya, Chr(44), ReplaceText)
                        End If
                    If InStr(Peremennaya, Chr(40)) >= 1 Then
                        Peremennaya = Replace(Peremennaya, Chr(40), ReplaceText)
                        End If
                    If InStr(Peremennaya, Chr(13)) >= 1 Then
                        Peremennaya = Replace(Peremennaya, Chr(13), ReplaceText)
                        End If
                    If InStr(Peremennaya, Chr(160)) >= 1 Then
                        Peremennaya = Replace(Peremennaya, Chr(160), Chr(32))
                        End If
                    If InStr(Peremennaya, Chr(42)) >= 1 Then
                        Peremennaya = Replace(Peremennaya, Chr(42), ReplaceText)
                        End If
                    Peremennaya = RTrim(Peremennaya)
                    If Right(Peremennaya, 1) = Chr(46) Then
                        PeremEdit = Len(Peremennaya) - 1
                        Peremennaya = Left(Peremennaya, PeremEdit)
                        End If
                    If Len(Peremennaya) <= 5 Then
                        x = x
                        GoTo Line00
                    End If
'Условия для сравнения переменной со значениями из массива. Если значения равны - повторяет цикл. Если в значении Переменной
'содержится значение массива - значение массива будет изменено. Если в значении массива содержится значение переменной, то
'цикл повторится. Значение переменной в первом и третьем случае не будет занесено в массив.
'Пометка 1
                        If Not FirstStorageArray(1) = Empty Then
                            For FromLowerToUpper = LBound(FirstStorageArray) To UBound(FirstStorageArray)
                            If Peremennaya Like FirstStorageArray(FromLowerToUpper) Then
                                GoTo Line00
                            ElseIf InStr(Peremennaya, FirstStorageArray(FromLowerToUpper)) >= 1 Then
                                FirstStorageArray(FromLowerToUpper) = Peremennaya
                                GoTo Line00
                            ElseIf InStr(FirstStorageArray(FromLowerToUpper), Peremennaya) >= 1 Then
                                GoTo Line00
                            End If
                            Next FromLowerToUpper
                        End If
                    x = x + 1
                    ReDim Preserve FirstStorageArray(x)
                    FirstStorageArray(x) = Peremennaya
Line00:
        Set OurRange = ActiveDocument.Paragraphs(iNumberOne).Range
        OurRange.SetRange Start:=OurRange.Start, End:=ActiveDocument.Paragraphs(iNumberTwo).Range.End
                Loop
                End With

5

Re: Range.Find VBA

Fck_This пишет:

Уважаемы, скажите, а это будет работать, если мне нужно найти все вхождения текста в области?

Если вы сразу хотите находить одно из нескольких возможных значений, то попробуйте обратиться к аппарату регулярных выражений (в Word реализованы wildcards - см., напр., внешняя ссылка. А проще - если не критично по времени, то переберите в цикле все абзацы, а в них - выполните поиск различных символов и соответствующие замены.

6

Re: Range.Find VBA

yshindin пишет:
Fck_This пишет:

Уважаемы, скажите, а это будет работать, если мне нужно найти все вхождения текста в области?

Если вы сразу хотите находить одно из нескольких возможных значений, то попробуйте обратиться к аппарату регулярных выражений (в Word реализованы wildcards - см., напр., внешняя ссылка. А проще - если не критично по времени, то переберите в цикле все абзацы, а в них - выполните поиск различных символов и соответствующие замены.

Спасибо за совет. Изначально была мысль просто перебрать все абзацы области. Но я же не ищу лёгких путей, как говорится. Думал открыть что-то новое.

7

Re: Range.Find VBA

yshindin пишет:
Fck_This пишет:

Уважаемы, скажите, а это будет работать, если мне нужно найти все вхождения текста в области?

Если вы сразу хотите находить одно из нескольких возможных значений, то попробуйте обратиться к аппарату регулярных выражений (в Word реализованы wildcards - см., напр., внешняя ссылка. А проще - если не критично по времени, то переберите в цикле все абзацы, а в них - выполните поиск различных символов и соответствующие замены.

ссылка не работает

8

Re: Range.Find VBA

yshindin пишет:
Fck_This пишет:

Уважаемы, скажите, а это будет работать, если мне нужно найти все вхождения текста в области?

Если вы сразу хотите находить одно из нескольких возможных значений, то попробуйте обратиться к аппарату регулярных выражений (в Word реализованы wildcards - см., напр., внешняя ссылка. А проще - если не критично по времени, то переберите в цикле все абзацы, а в них - выполните поиск различных символов и соответствующие замены.

Про регулярные выражения я знаю, но дело в том, что подобрать одно для всех невозможно, а через цикл Do while MyRange.Find.Execute = True MyRange становится равной FindText. Макрос ищет по первой регулярке, а затем делает её областью и вторую уже не ищет.

 First = "СТБ[!A-Za-zА-яЁё]ГОСТ[!A-Za-zА-яЁё]Р[!A-Za-zА-яЁё\[]{1;}"
Second = "СТБ[!A-Za-zА-яЁё]ЕН[!A-Za-zА-яЁё\[]{1;}"
Third = "СТБ[!A-Za-zА-яЁё]ISO[!A-Za-zА-яЁё\[]{1;}"
Fourth = "СТБ[!A-Za-zА-яЁё\[]{1;}"
Fifth = "ГОСТ[!A-Za-zА-яЁё]ИСО[!A-Za-zА-яЁё\[]{1;}"
Sixth = "ГОСТ[!A-Za-zА-яЁё]Р[!A-Za-zА-яЁё\[]{1;}"
Seventh = "ГОСТ[!A-Za-zА-яЁё]ISO[!A-Za-zА-яЁё\[]{1;}"
Eighth = "ГОСТ[!A-Za-zА-яЁё\[]{1;}"
Ninth = "ТР[!A-Za-zА-яЁё\[]ТС[!A-Za-zА-яЁё\[]{1;}"
Tenth = "ИСО[!A-Za-zА-яЁё\[]{1;}"

9

Re: Range.Find VBA

Fck_This пишет:

ссылка не работает

Еще раз: внешняя ссылка