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

@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 **[ТС]**

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

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

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

	Поиск слов в тексте 28.11.2009, 18:21. Показов 11443. Ответов 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