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

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

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

Новые блоги и статьи Все статьи Все блоги /
My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .
Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача №1: при указании работ (справочник РаботыПоРемонтуСпецтехники),. . .

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

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