Поиск общих слов в двух вордовских файлах

@How_much_watch · Регистрация: 25.10.2011

Студворк — интернет-сервис помощи студентам

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

@Казанский · 27.10.2011, 10:41

Сообщение от How_much_watch

обозначьте пожалуйста в общих чертах хотя б

Запишите в макрос такие действия во втором файле:
Ctrl+Home
Ctrl+H, найти: орёл, заменить на: пусто, формат: выделение цветом, Заменить все.

Это для одного слова. Остается прикрутить цикл по всем словам (абзацам?) из первого файла.

@How_much_watch · 27.10.2011, 17:31 **[ТС]**

Спасибо большое, уже многое получилось, но работает не совсем корректно.
1. Выделяет только последнее проверенное слово, а мне нужно все.
2. В будущем я хочу привязать и второй такой же файл из которого буду брать слова. Соответственно мне нужно будет, чтобы слова взятые из разных файлов помечались разным цветом, можно ли такое реализовать?
3. Мелькают файлы на экране во время выполнения кода ). Не суть конечно, но можно ль избавиться?
Листинг привожу:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 Sub Find()
'
' Find Макрос
'
'
Dim i&, s$
 
    Documents.Open FileName:="F:\ри\Test\Doc2.docx", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto, XMLTransform:=""
    Selection.HomeKey Unit:=wdStory
 
For i = 1 To ActiveDocument.Paragraphs.Count
    With ActiveDocument.Paragraphs(i).Range
        s = .Text
 
    Windows("Doc1").Activate
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = s
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Windows("Doc2").Activate
 
    End With
Next
 
    ActiveWindow.Close
    
End Sub

Добавлено через 23 минуты
мм.. . Меня терзают смутные сомненья, что с помощью этого выделения реализовать задачу не удастся..

Добавлено через 4 часа 0 минут
Написал программу заново. Она должна работать, но не работает ). Пожалуйста, не постесняйтесь просмотреть, мне нужен ваш совет )

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Find()
'
' Find Макрос
'
'
Dim i&, tel$, s$, i2&, j2&
    Documents.Open FileName:="F:\ри\Test\Doc2.docx", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto, XMLTransform:=""
    Selection.HomeKey Unit:=wdStory
 
For i = 1 To ActiveDocument.Paragraphs.Count
    With ActiveDocument.Paragraphs(i).Range
        tel = .Text
    End With
 
Windows("Doc1").Activate
 
For i2 = 1 To ActiveDocument.Paragraphs.Count
    With ActiveDocument.Paragraphs(i2).Range
       For j2 = 1 To ActiveDocument.Paragraphs(i2).Range.Words.Count
            With ActiveDocument.Paragraphs(i2).Range.Words(j2)
            If StrComp(tel, .Text) = 0 Then
              .Select
               Selection.Font.Color = wdColorRed
            End If
            End With
        Next
     End With
Next
 
Windows("Doc2").Activate
 
Next
 
ActiveWindow.Close
 
End Sub

@Sasha_Smirnov · 28.10.2011, 05:00

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub СколькоНас()
    Dim strF 'искомая строка
    Dim intN 'количество вхождений    
    Selection.HomeKey wdStory 'в начало документа'
    
    strF = Trim(InputBox("Фамилия?", "Количество экземпляров", "Иванов-Вано"))
 
    'тут, если программировать путём записи макроса, очищается формат поиска и замены
    With Selection.Find
        Do
            .Text = "<" & strF         'то, что ищем в тексте документа Word
            .Wrap = wdFindStop         'останавливаемся на найденном
            .Format = False            'формат при поиске не учитываем
            .MatchCase = False         'заглавные/строчные не учитываем
            .MatchWholeWord = False    'не только слова целиком (чтоб не мешали падежи)
            .MatchWildcards = True     'флажок "Подстановочные знаки" (окно поиск/замена)
            .Execute
            intN = intN + 1
        Loop Until Not .Found
    End With
    
    MsgBox "Строка «" & strF & "» найдена в количестве: " & intN - 1 & "."
End Sub

Вам падежи наверно не нужны... Но это (как я сам думаю) кое-что прояснит. После испытания полезно нажать контрол-аш (Ctrl-H) и взглянуть на панель поиска-замены — там (если в коде не очищать и не закрывать Word) висят настройки последнего поиcка.

А вот тут о выделении цветом: Условие по наличию слова в файл

В том числе и разным цветом: Условие по наличию слова в файл

(Сейчас мне не хватит энтузиазма всё это собирать и скручивать... а тем более пытать ваш код.)

Добавлено через 12 минут
А «штатными» средствами США всё это, как мне кажется, можно провернуть путём индексации и сборки Словаря-указателя (раздел 3.8. Поля). Но это так, для 1% продвинутых фанатов.

@How_much_watch · 28.10.2011, 12:01 **[ТС]**

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Find2()
'
' Find2 Макрос
'
'
Dim i&, s$ 
    Documents.Open FileName:="D:\ри\Test\Doc2.docx", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto, XMLTransform:=""
    Selection.HomeKey Unit:=wdStory 
For i = 1 To ActiveDocument.Paragraphs.Count
    With ActiveDocument.Paragraphs(i).Range.Words(1)
        s = .Text
     Windows("Doc1").Activate
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = s
        .Replacement.Text = s
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .HitHighlight .Text, HighlightColor:=wdColorRed
    End With
    Windows("Doc2").Activate 
    End With
Next 
    ActiveWindow.Closed Sub

Вариант лучше:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Find()
'
' Find Макрос
'
Dim i&, tel$, s$, i2&, j2&, s2$
    Documents.Open FileName:="D:\ри\Test\Doc2.docx", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto, XMLTransform:=""
    Selection.HomeKey Unit:=wdStory
For i = 1 To ActiveDocument.Paragraphs.Count
    With ActiveDocument.Paragraphs(i).Range.Words(1)
        tel = .Text
    End With
Windows("Doc1").Activate
For i2 = 1 To ActiveDocument.Paragraphs.Count
    With ActiveDocument.Paragraphs(i2).Range
       For j2 = 1 To ActiveDocument.Paragraphs(i2).Range.Words.Count
            With ActiveDocument.Paragraphs(i2).Range.Words(j2)
            s2 = ActiveDocument.Paragraphs(i2).Range.Words(j2)
            If StrComp(tel, s2) = 0 Then
              .Select
               Selection.Font.Color = wdColorRed
            End If
            End With
        Next
     End With
Next
Windows("Doc2").Activate
Next
ActiveWindow.Close 
End Sub

@Sasha_Smirnov · 28.10.2011, 14:42

В процедуре Find2() то, что в строках 21—29, лишнее (если окно поиска до её запуска было чистым). Кстати, проверьте. Но главное в бою быть с оружие на ты, и у вас оно так!

Вообще, если вариант 2 лучше, то не стоит «полировать» 1-й.

Новые блоги и статьи Все статьи Все блоги /
Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Символьное дифференцирование igorrr37 13.02.2026 / * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@How_much_watch 25 / 0 / 0 Регистрация: 25.10.2011 Сообщений: 25

	Поиск общих слов в двух вордовских файлах 27.10.2011, 09:58. Показов 5521. Ответов 5 Метки нет (Все метки) Мне бы очень пригодился макрос, который искал бы слово в первом вордовском файле и выделял его (может каким нибудь цветом) во втором, если оно есть. Если кому не трудно, обозначьте пожалуйста в общих чертах хотя б. В первом файле слова расположены удобно - одно слово - одна строка. Во втором текст. Например: 1-й файл: иванов молодой петров орёл 2-й файл: гляжу поднимается медленно в гору вскормленный в неволе орёл молодой ... Общие слова "орёл" и "молодой" мне нужно как-то выделить во втором файле. Помогите, пожалуйста, кому не трудно.. 0

@Sasha_Smirnov 5562 / 1370 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	28.10.2011, 14:42
	В процедуре Find2() то, что в строках 21—29, лишнее (если окно поиска до её запуска было чистым). Кстати, проверьте. Но главное в бою быть с оружие на ты, и у вас оно так! Вообще, если вариант 2 лучше, то не стоит «полировать» 1-й. 0