VBA находит первое вхождение строки - PullRequest
Новая
       17

VBA находит первое вхождение строки

0 голосов
/ 02 сентября 2011

У меня есть следующие данные 

]
Word1
Word2
Word3
Word4[ Data1
]
Word1
Word2
Word3
Word4[ Data2
]

В основном мой макрос ищет ]*[, находя данные выше [*] - затем он выполняет некоторые проверки. Затем я хочу найти следующую часть ([*]) и еще раз проверить содержимое, прежде чем перейти к следующей ]*[

на данный момент это в основном поиск первого ]*[, затем каждого из [*], но не следующего ]*[

headerSearch.Find.ClearFormatting
With headerSearch.Find
    .text = "(\])(*)(\[)"
    .Replacement.text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
End With

itemCount = 0
multipleRespoErrors = 0

Do While headerSearch.Find.Execute = True

Dim contentSearch As Object
Set contentSearch = Application.Selection


'find the item content
contentSearch.Find.ClearFormatting
With contentSearch.Find
    .text = "(\[)(*)(\])"
    .Replacement.text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
End With
contentSearch.Find.Execute
    findContent = lcase(Selection)
loop

Есть идеи?

Ответы [ 2 ]

1 голос
/ 09 сентября 2011

Я думаю, что код ниже решит вашу проблему. Однако, поскольку нам нужно использовать альтернативный шаблон поиска, функциональности поиска Word будет недостаточно. Чтобы компенсировать это, я создал закладку (невидимый маркер в Word, к которому можно получить доступ через код VBA), где бы ни была скобка, и использовал эту систему для чередования шаблона поиска.

Первый шаг - создание закладок. Два отдельных поиска - по одному для левой и правой скобок - завершают это. Каждой закладке присваивается имя «Закладка» с добавлением номера, чтобы они имели цифровую маркировку в порядке появления. 

Public Sub PlaceBookmarks()

Dim SearchRange As Range
Dim BookmarkRange As Range
Dim x As Integer

x = 1
Set SearchRange = ActiveDocument.Range

SearchRange.Find.ClearFormatting
With SearchRange.Find
    .Text = "(\])"
    .Forward = True
    .Wrap = wdFindStop 'end bookmark creation at end of document
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    While .Execute
        If .Found = True Then
            .Parent.Select
            Selection.Collapse
            Selection.MoveRight unit:=wdCharacter, Count:=1 'place bookmark to right of bracket
            Set BookmarkRange = Selection.Range
            ActiveDocument.Bookmarks.Add "Bookmark" & x, BookmarkRange
            x = x + 2
        End If
    Wend
End With

x = 2
Set SearchRange = ActiveDocument.Range
SearchRange.Find.ClearFormatting
With SearchRange.Find
    .Text = "(\[)"
    .Forward = True
    .Wrap = wdFindStop 'end bookmark creation at end of document
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    While .Execute
        If .Found = True Then
            .Parent.Select
            Selection.Collapse
            Selection.MoveRight unit:=wdCharacter, Count:=1 'place bookmark to right of bracket
            Set BookmarkRange = Selection.Range
            ActiveDocument.Bookmarks.Add "Bookmark" & x, BookmarkRange
            x = x + 2
        End If
    Wend
End With

End Sub

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

Public Sub FindRange()

Dim BookmarkCount As Integer
Dim x As Integer
Dim BookmarkRange As Range
Dim FirstPatternRange As Range

BookmarkCount = ActiveDocument.Bookmarks.Count

With ActiveDocument
    For x = 1 To BookmarkCount
        If .Bookmarks.Exists("Bookmark" & x + 1) Then

            'Move end bookmark to exclude bracket
            .Bookmarks("Bookmark" & x + 1).Select
            Selection.MoveLeft unit:=wdCharacter, Count:=1
            Set BookmarkRange = Selection.Range
            .Bookmarks.Add "Bookmark" & x + 1, BookmarkRange 'this moves the bookmark by re-adding it

            Set FirstPatternRange = .Range(.Bookmarks("Bookmark" & x).Range.Start, .Bookmarks("Bookmark" & x + 1).Range.End)
            'Perform checks on data between ][

            'Move leading bookmark to exclude bracket
            .Bookmarks("Bookmark" & x + 1).Select
            Selection.MoveRight unit:=wdCharacter, Count:=1
            Set BookmarkRange = Selection.Range
            .Bookmarks.Add "Bookmark" & x + 1, BookmarkRange 'this moves the bookmark by re-adding it

            'Move trailing bookmark to exclude bracket
            .Bookmarks("Bookmark" & x + 2).Select
            Selection.MoveLeft unit:=wdCharacter, Count:=1
            Set BookmarkRange = Selection.Range
            .Bookmarks.Add "Bookmark" & x + 2, BookmarkRange 'this moves the bookmark by re-adding it

            Set FirstPatternRange = .Range(.Bookmarks("Bookmark" & x + 1).Range.Start, .Bookmarks("Bookmark" & x + 2).Range.End)
            'Perform checks on data between []

            'Reset trailing bookmark for next iteration
            .Bookmarks("Bookmark" & x + 2).Select
            Selection.MoveRight unit:=wdCharacter, Count:=1
            Set BookmarkRange = Selection.Range
            .Bookmarks.Add "Bookmark" & x + 2, BookmarkRange 'this moves the bookmark by re-adding it

            x = x + 1
        End If
    Next
End With
End Sub

Если вы планируете выполнять операции VBA над текстом в будущем, вы, вероятно, захотите написать For Each / Next, чтобы удалить все созданные закладки. Надеюсь, это поможет.

0 голосов
/ 20 января 2019

Вы можете использовать что-то на основании следующего Изменив подстановочный знак Поиск выражений, процесс довольно прост. 

With headerSearch
  With .Find
    .ClearFormatting
    'Find ranges bounded by ] & [, excluding the final [
    .Text = "\][!\[\]]{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Format = False
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found = True
    'Confirm that the next character is a [, just
    'in case we've gone beyond the last ] & [ pair
    If .Characters.Last.Next = "[" Then
      'Exclude the leading ], so all we're left with is the range between ] & [
      .Start = .Start + 1
      MsgBox "Text bounded by ] & [:" & vbCr & .Text
      With .Duplicate
        With .Find
          'Find the next range bounded by [ & ], excluding the final ]
          .Text = "\[[!\[\]]{1,}"
          .Forward = True
          .Format = False
          .Wrap = wdFindContinue
          .MatchWildcards = True
          .Execute
        End With
        If .Find.Found = True Then
          'Confirm that the next character is a ], just
          'in case we've gone beyond the last [ & ] pair
          If .Characters.Last.Next = "]" Then
            'Exclude the leading [, so all we're left with is the range between [ & ]
            .Start = .Start + 1
            MsgBox "Text bounded by [ & ]:" & vbCr & .Text
          End If
        End If
      End With
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
...