Вынести слова по маске

[SKth]

Есть проблема. Суть такова - надо выбрать фразы из большого текста и скопировать их в отдельный файл, в зависимости от его "соседей".
Например : [слово] [Главное слово] [слово]. Все разумеется разделено пробелами.

пытался пробовать разные конструкции поиска, например [ ]*[ ]Укр.[ ]*[ ], но не очень помогает - постоянно захватываются слишком большие куски текста.

В общем помогите)
Немного сумбурно написал, но надеюсь суть ясна.

[viter.alex]

Суть не ясна. Приложите пример документа, или конкретный пример фразы
Попробуйте так:
Найти: слово1 <[А-яЁё]@> слово2
Подстановочные знаки включены.
Если поможет, тогда можно дальше идти

[SKth]

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

PHP код:

аброгация юр. аброгація.
абруптив лингв, абруптив.
абрупция муз. абрупція.
абсанс мед. абсанс, -у.
абсентизм мед. абсентизм, -у. 


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

<[А-яЁё]@> мед. <[А-яЁё]@>
вариант сработал) спасибо))
вдогонку вопрос - как можно сделать, чтобы в новый документ каждая выноска шла на новую строчку?

[viter.alex]

Каждая фраза находится в одном абзаце? Так, как в примере? Окончания нужно копировать?

[SKth]

Фраза да, в абзаце.
Окончания пофигу, т.е

аброгация юр. аброгація.

так.

[viter.alex]

Пробуй.

Sub ExtractDefinitions()
  Dim oNewDoc As Document 'Новый документ
  Dim oDoc As Document 'Документ для поиска
  Dim BranchAbbr As String 'Аббревиатура
  Dim bFound As Boolean 'Результат поиска
  
  Set oDoc = ActiveDocument
  Set oNewDoc = Documents.Add
  BranchAbbr = InputBox("Введите аббревиатуру для отрасли", "Извлечение статей")
  
  If Len(BranchAbbr) = 0 Then Exit Sub
  
  With oDoc.Range.Find
    .Text = "<[А-яЁё]@> " & BranchAbbr & " <[А-яЁё]@>"
    .MatchWildcards = True
    While .Execute
      bFound = .Found
      oNewDoc.Range.InsertAfter .Parent.Paragraphs.First.Range.Text
    Wend
  End With
  'Если ничего не найдено, то документ закрываем без сохранения
  If Not bFound Then oNewDoc.Close False
  
  Set oDoc = Nothing: Set oNewDoc = Nothing
End Sub