Страницы: 1
RSS
Поиск и копирование строки в новый документ
 
Приветствую. Прошу помощи с макросом.
Нужно находить слова (словосочетания) в тексте и по найденому слову, копировать всю строку (абзац) в другой документ (у меня другой документ назван "Совпадения".
пример: Как в сказке о царе Салтане. Находить слово мама и всю строку(абзац) копировать в другой документ. Поиск произвожу стандартным вордовским "найти". Документ для примера со словом мама прикрепляю (отрывок из царя Салтана).
пример.docx (14.74 КБ)

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

Макрос, вполне может подойти и для подобных задач в Excel

Макрос, что у меня получился
Код
Sub Макрос2()
'
' Макрос2 Макрос
'
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=14
    Selection.MoveRight Unit:=wdCharacter, Count:=29, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    Windows("Совпадения.docx").Activate
    Windows("Документ2").Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.MoveLeft Unit:=wdCharacter, Count:=6
    Selection.MoveRight Unit:=wdCharacter, Count:=28, Extend:=wdExtend
    Selection.Copy
    Windows("Совпадения.docx").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.TypeParagraph
    Windows("Документ2").Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=16
    Selection.MoveRight Unit:=wdCharacter, Count:=30, Extend:=wdExtend
    Selection.Copy
    Windows("Совпадения.docx").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.TypeParagraph
    Windows("Документ2").Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "мама"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.Find.Execute
End Sub
 
Перебором абзацев:
Код
Sub text()
For Each st In ActiveDocument.Paragraphs
    If LCase(st.Range.text) Like "*мама*" Then MsgBox st.Range.text 'Тут совершаем копирование
Next
End Sub
 
magistor8  а моя заготовка не подходит к даному сценарию
 
magistor8  либо я чего не так делаю, либо он находит только мама. При запросе другого слова находит только мама
 
magistor8 каждый новый запрос слова, нужно вписывать и сохранять в макрос? (помогите доразобраться)
 
Доброе время суток.
Цитата
sevik111 написал:
либо я чего не так делаю, либо он находит только мама. При запросе другого слова находит только мама
Вполне естественно. Где сборник ключевых слов, фраз?
Цитата
sevik111 написал:
Нужно находить слова (словосочетания) в тексте
Вы предоставили только слово мама, даже не указав, в каком виде и как это будет храниться. Каков был пример, таков получился и ответ.

Updated
Вариант с заданным в шаблоне регулярного выражения списком слов (можно и выражений).
Код
Private Const testPattern = "(?:[""\-\. :;\(]|^)(?:гонца|отца|мама)(?:[""\-\. :;\)]|\n|$)"

Public Sub CopyParagraphByTestPattern()
    Dim pReg As Object, pPara As Paragraph
    Dim destDoc As Document, newPara As Paragraph
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.IgnoreCase = True: pReg.Pattern = testPattern
    Set destDoc = Nothing
    For Each pPara In ThisDocument.Paragraphs
        If pReg.Test(pPara.Range.Text) Then
            If destDoc Is Nothing Then Set destDoc = Application.Documents.Add
            Set newPara = destDoc.Paragraphs.Add
            newPara.Range.Text = pPara.Range.Text
        End If
    Next
End Sub
Изменено: Андрей VG - 06.04.2019 10:53:56
 
Андрей VG этот вариант немного легче предыдущего. Но все равно шаблонов придется не мало составить. Оптимальным вариантом, был бы через поиск (в том же ворде, ексель). Если не автоматом (перелопачивал весь документ), то хоть после каждого нажатия на "найти далее", что бы выделялся абзац и при запуске макроса, копировал в определенный документ (один и тот самый). Например: ищем нужные фразы в "новом, любом документе" и макрос копирует найденные совпадения в конкретный документ, скажем, под названием  "Y" Мне для дальнейшей работы этого будет вполне достаточно.
У меня нет большого опыта работы с макросами, вот и получилась заготовка, мягко говоря "так себе".


"в каком виде и как это будет храниться"  - для меня достаточно в текстовом формате, в новом документе (для дальнейшей работы). Но только не каждая новая строка (абзац) в новом документе, а все найденные совпадения, в одном документе (я поэтому и назвал новый документ "Совпадения").
 
Цитата
sevik111 написал:
копировал в определенный документ (один и тот самый)
Как определён этот документ, где расположен? Поменяйте в коде инициализацию destDoc - и получите желаемое.
Цитата
sevik111 написал:
Оптимальным вариантом, был бы через поиск (в том же ворде, ексель).
Как определён этот список? Пока вижу картинку, в которой в поле ввода через точку с запятой указан такой список слов. Не вижу большой сложности написать код формы, который будет формировать шаблон для регулярного выражения. Для этого достаточно вместо
Private Const testPattern
создать публичную переменную
Код
Public testPattern As String
и в неё перед запуском предложенного метода формировать тот самый шаблон.
Цитата
sevik111 написал:
Но только не каждая новая строка (абзац) в новом документе, а все найденные совпадения
расшифруйте, и приложите пример, не понимаю этой фразы совсем.
 
Цитата
Как определён этот список? Пока вижу картинку, в которой в поле ввода через точку с запятой указан такой список слов. Не вижу большой сложности написать код формы, который будет формировать шаблон для регулярного выражения
Список определяю я сам. Регулярных выражений нет.  Если в одном документе мне нужно найти слово "мама", то в другом мне нужно найти "бабушку". (это примерные слова). Или в одном документе могу искать и 10, и 100 слов.

Цитата
Как определён этот документ, где расположен?
Он у меня расположен в корне диска D (D:\Совпадения.dosx)


Цитата
Но только не каждая новая строка (абзац) в новом документе, а все найденные совпадения
Предположим мне нужно найти словосочетание "иду гулять". В поиске я вбиваю искомую фразу "иду гулять" и нажимаю найти далее. Поиск находит фразу (совпадение, каких в документе может быть десятки) и с помощью макроса, мне нужно: 1 копирнуть абзац (с найденным словом, словосочетанием), 2 перейти на новую вкладку (по имени "Совпадения") и вставить найденный абзац, 3 возвращаюсь обратно в документ и ищу следующее совпадение, с той же искомой комбинацией "иду гулять"
Когда поиск комбинации "иду гулять" закончен, я начинаю искать другое искомое слово, скажем "Салтана". И тут задача для макроса, та-же самая. Найти искомое слово в тексте, копирнуть весь абзац с этим словом и вставить этот абзац в документ по имени "Совпадения".
Вот почему прописать в макрос, все искомые слова и словосочетания - затруднительно (их огромное количество получится). Я поэтому и пользуюсь вордовским (экселевским) поиском. Он справляется со своей задачей на 200% (для моих потребностей). Единое, что тормозит мою работу - копирование абзаца, вставка в документ "совпадения", возвращение обратно в искомый документ, и продолжение поиска. Для этого мне и нужен макрос, что бы облегчить копировку, вставку.  
 
Как-то так. Документ "Совпадения.docx" должен быть открыт.
 
Андрей VG простите, что не сразу смог объяснить то, что мне было нужно. Неплохое решение! Большое спасибо. Вопрос решен!
Страницы: 1
Наверх