Поиск слов в тексте

@krendel34rus · Регистрация: 27.11.2009

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

Пожалуйста, помоги с макросом. Нужно чтобы он выводил диалоговое окно, где мы бы указывали массив символов. Это первый массив. Затем запрашивается второй массив. После чего макрос ищет в тексте сочетания символов, идентичные первому массиву и, если это не конец слова, ищет конец слова и вставляет метку: {XE "второй массив"}.
Для чего это нужно: макрос поможет пометить все однокоренные слова именем второго массива, у которых корень - первый массив.

@Busine2009 · 28.11.2009, 19:06

Ну ты блин даёшь. Я бы никогда тебе не смог бы помочь, прочитав твой вопрос.
Вот макрос

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Indexes()
Dim x As String
Dim y As String
Dim oStory As Range
Dim oWord As Range
x = InputBox("Введите корень, для отображение нужного слова в Указателе")
y = InputBox("Введите слово, которое должно быть в Указателе")
Application.ScreenUpdating = False
ActiveWindow.ActivePane.View.ShowAll = False
For Each oStory In ActiveDocument.StoryRanges
    For Each oWord In oStory.Words
        If InStr(oWord, x) > 0 Then
            oWord.Select
            ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:=y
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            Selection.MoveRight Unit:=wdCharacter, Count:=1
        End If
    Next oWord
Next oStory
Application.ScreenUpdating = True
End Sub

Если ты работаешь в режиме отображения Непечатаемых символов, то надо будет добавить ещё одну строчку.
Сам указатель вставишь вручную.

Добавлено через 13 минут
Последний вариант. Перед применением макроса сделай копию документа на всякий пожарный.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Indexes()
Dim x As String
Dim y As String
Dim oWord As Range
x = InputBox("Введите корень, для отображение нужного слова в Указателе")
y = InputBox("Введите слово, которое должно быть в Указателе")
Application.ScreenUpdating = False
ActiveWindow.ActivePane.View.ShowAll = False
    For Each oWord In ActiveDocument.Words
        If InStr(oWord, x) > 0 Then
            oWord.Select
            ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:=y
        End If
    Next oWord
Application.ScreenUpdating = True
End Sub

Этот макрос применим только к Основному документу, т.е. Колонтитулы, Сноски, Надписи - ну учитываются.

@krendel34rus · 29.11.2009, 12:26 **[ТС]**

А как ворд ищет слова?
Я представлял, что он будет перебирать все символы подряд, пока не наткнется на: пробел, дефис, точку, запятую, ¤, знак ввода. Может еще, что забыл

А такая схема походу не корректно работает. Вот пример файла

И, насколько я понял, InputBox имеет стандартную форму, и кнопка OK означает записать, а Cancel - записать пустую строку. То есть отменить выполнение макроса уже нельзя

@Busine2009 · 29.11.2009, 13:48

krendel34rus,
В этом варианте учитываются Сноски. А для Колонтитулов и Надписей Указатели не предусмотрены. Этот Макрос чувствителен к регистру, поэтому макрос для одного Корня должен применяться 2 раза: 1 раз вводишь корень с Большой буквы, 2 - с маленькой.

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
Sub Indexes()
Dim x As String
Dim y As String
Dim oWord As Range
Dim oFootnote As Footnote
x = InputBox("Введите корень", "Производим пометку")
у = InputBox("Введите слово, которое должно быть в Указателе", "Производим пометку")
Application.ScreenUpdating = False
ActiveWindow.ActivePane.View.ShowAll = False
For Each oWord In ActiveDocument.Words
    If InStr(oWord, x) > 0 Then
        oWord.Select
        ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:=у
    End If
Next oWord
For Each oFootnote In ActiveDocument.footnotes
    For Each oWord In oFootnote.Range.Words
        If InStr(oWord, x) > 0 Then
            oWord.Select
            ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:=у
        End If
    Next oWord
Next oFootnote
Application.ScreenUpdating = True
End Sub

Про InputBox сейчас почитаю.
Да, и тебе это надо для профессиональной деятельности или 1-2 раза применить? Если 1-2 раза, то этого достаточно.

Добавлено через 18 минут
krendel34rus,
Вот нашёл кое-что. Вставь это

Visual Basic
1
2
If x = Empty Then Exit Sub
If y = Empty Then Exit Sub

после

Visual Basic
1
2
x = InputBox("Введите корень", "Производим пометку")
у = InputBox("Введите слово, которое должно быть в Указателе", "Производим пометку")

соответственно после х вставь про х, после y про y.
При нажатии на Cancel InputBox принимает значение Empty. Также выход из программы будет происходить, если ты ничего не введёшь в поле и нажмёшь Ок.

Добавлено через 30 минут
krendel34rus,

А как ворд ищет слова?
Я представлял, что он будет перебирать все символы подряд, пока не наткнется на: пробел, дефис, точку, запятую, ¤, знак ввода. Может еще, что забыл

Я честно говоря, плохо представляю, как и что работает, я просто складываю различные строчки кодов вместе, находя их в Справке, на др. Форумах, записав их с помощью Макрорекордера.
Вот эта строчка мне и самому не понята

Visual Basic
1
For Each oWord In ActiveDocument.Words

т.к. здесь oWord является

Visual Basic
1
Dim oWord As Range

диапазоном, а на самом деле я подразумеваю под oWord одно любое слово в данном документе.
Если абстрагироваться и не вдаваться в подробности, то эта строка

Visual Basic
1
For Each oWord In ActiveDocument.Words

означает: для каждого слова в данном документе. Т.е. мы просматриваем все слова в документе, начиная с первого и заканчивая последним.
Вот эта строка

Visual Basic
1
If InStr(oWord, x) > 0 Then

означает следующее.
InStr является функцией VBA, с помощью которой можно выяснить, есть ли в данном фрагменте, нужный нам фрагмент. oWord - это слово в документе, а x - фрагмент который мы ищем, в данном случае x является Корнем. Если в oWord есть x, то вот это выражение InStr(oWord, x) будет больше нуля, если нету, то будет равно 0. И соответственно данная строка

Visual Basic
1
If InStr(oWord, x) > 0 Then[

читается: если в данном слове есть корень, то.
Затем я просто выделяю это слово и помечаю его. Пометку я записал с помощью Макрорекордера, а затем из полученного кода удалил то, что посчитал ненужным.

@krendel34rus · 29.11.2009, 15:26 **[ТС]**

Спасибо за подробное разъяснение. В программе были некоторые недостатки.

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 Indexes()
Dim x As String
Dim y As String
Dim oWord As Range
Dim oFootnote As Footnote
x = InputBox("Введите корень", "Производим пометку")
    ' <---
    If x = Empty Then
        Exit Sub
    End If
    ' <---
у = InputBox("Введите слово, которое должно быть в Указателе", "Производим пометку")
    ' <---
    If y <> Empty Then
        Exit Sub
    End If
    ' <---
Application.ScreenUpdating = False
ActiveWindow.ActivePane.View.ShowAll = False
For Each oWord In ActiveDocument.Words
    If InStr(oWord, x) <> 0 Then ' <---
        oWord.Select
        ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:=у
    End If
Next oWord
For Each oFootnote In ActiveDocument.Footnotes
    For Each oWord In oFootnote.Range.Words
        If InStr(oWord, x) <> 0 Then ' <---
            oWord.Select
            ActiveDocument.Indexes.MarkEntry Range:=Selection.Range, Entry:=у
        End If
    Next oWord
Next oFootnote
Application.ScreenUpdating = True
End Sub

Всё это было отслежено пошагово - F8.
Конечно же закрыл If. Далее, y почему-то действует наоборот: поставил не равно. oWord действует замечательно. Он реально ищет отдельные слова и символы. Но только функция InStr возвращает порядковый номер вхождения первого элемента x в oWord. Если х входит в oWord, значит его номер любой, кроме ноля.

Вот. Busine2009, огромное спасибо за помощь!

@Busine2009 · 29.11.2009, 15:32

krendel34rus,

Visual Basic
1
2
3
If x = Empty Then
        Exit Sub
    End If

Так нельзя делать, у меня этот фрагмент то работает, то не работает. Оставь так, как я написал - это не была ошибка. Вот наверное y у тебя и действовал наоборот, потому что ты закрыл if.

@krendel34rus · 29.11.2009, 15:44 **[ТС]**

Visual Basic
1
2
3
4
x = InputBox("Введите корень", "Производим пометку")
If x = Empty Then Exit Sub
у = InputBox("Введите слово, которое должно быть в Указателе", "Производим пометку")
If y = Empty Then Exit Sub

При пошаговой компиляции программа заканчивается там, где я подчеркнул. Попробуйте сами.
А If действительно не обязательно закрывать. Но у меня нет практики в VBA, поэтому пока работало и с закрытым

@Busine2009 · 29.11.2009, 15:58

krendel34rus,
я к тому, что тоже раньше использовал end if при закрытии в этом случае, но у меня почему-то код неправильно работал, точно не помню что, кажется не выходил из программы.

Добавлено через 6 минут
krendel34rus,
да ты прав, я видимо забыл протестировать до конца.

@Busine2009 · 29.11.2009, 18:28

krendel34rus,
Может я ошибаюсь и не учитываю каких-нибудь факторов, но если x и y заменить на переменные с другими именами, например, xIndex и yIndex, то end if не нужен, а y можно сделать равным 0.

@krendel34rus · 30.11.2009, 02:10 **[ТС]**

Мне тоже не понятно почему, но это так

@Busine2009 · 30.11.2009, 05:17

krendel34rus,
а у меня макрос с другого форума не работает, у меня очень много пометок появляется.

@krendel34rus · 01.12.2009, 23:57 **[ТС]**

У меня сначала работал, причем отлично (в четыре раза быстрее поиска по каждому слову) Но когда принес на работу, почему-то тоже стал делать кучу меток на одно и то же слово, и пришлось его просто прервать. Не могу это объяснить...пока.

Новые блоги и статьи Все статьи Все блоги /
Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114	Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и напряжениями. Надо найти токи в ветвях. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и решает её. Последовательность действий:. . .
Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .	Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .

@krendel34rus 0 / 0 / 0 Регистрация: 27.11.2009 Сообщений: 11

	Поиск слов в тексте 28.11.2009, 18:21. Показов 11467. Ответов 11 Метки нет (Все метки) Пожалуйста, помоги с макросом. Нужно чтобы он выводил диалоговое окно, где мы бы указывали массив символов. Это первый массив. Затем запрашивается второй массив. После чего макрос ищет в тексте сочетания символов, идентичные первому массиву и, если это не конец слова, ищет конец слова и вставляет метку: {XE "второй массив"}. Для чего это нужно: макрос поможет пометить все однокоренные слова именем второго массива, у которых корень - первый массив. 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	29.11.2009, 15:58
	krendel34rus, я к тому, что тоже раньше использовал end if при закрытии в этом случае, но у меня почему-то код неправильно работал, точно не помню что, кажется не выходил из программы. Добавлено через 6 минут krendel34rus, да ты прав, я видимо забыл протестировать до конца. 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	29.11.2009, 18:28
	krendel34rus, Может я ошибаюсь и не учитываю каких-нибудь факторов, но если x и y заменить на переменные с другими именами, например, xIndex и yIndex, то end if не нужен, а y можно сделать равным 0. 0

@krendel34rus 0 / 0 / 0 Регистрация: 27.11.2009 Сообщений: 11
	30.11.2009, 02:10 [ТС]
	Мне тоже не понятно почему, но это так 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	30.11.2009, 05:17
	krendel34rus, а у меня макрос с другого форума не работает, у меня очень много пометок появляется. 0

@krendel34rus 0 / 0 / 0 Регистрация: 27.11.2009 Сообщений: 11
	01.12.2009, 23:57 [ТС]
	У меня сначала работал, причем отлично (в четыре раза быстрее поиска по каждому слову) Но когда принес на работу, почему-то тоже стал делать кучу меток на одно и то же слово, и пришлось его просто прервать. Не могу это объяснить...пока. 0