Выделение слова в тексте

@Baykal555 · Регистрация: 08.09.2017

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

Добрый день!

Необходимо выделить определенные заранее известные слова в ячейке с текстом.

Нужно чтобы было что-то вроде:

Sub slovo()

slovo = "Рубашка"

If slovo in Range("A1:C10") then

slovo.Interior.Color = vbGreen

End If

End Sub

То есть программа находила слово "Рубашка" и выделяла его зеленым.

Как это реализовать?

Спасибо!

@hamin · 14.08.2018, 14:40

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub SelectWord(word As String, Optional color As Long = vbGreen, Optional defaultColor As Long = 0)
    
    Dim cell As Range
    Dim idx As Integer
    
    Set cell = ActiveCell
    
    idx = InStr(1, cell.Value, word)
    
    If idx <> 0 Then
        cell.Characters(1, idx - 1).Font.color = defaultColor
        cell.Characters(idx, Len(word)).Font.color = color
        cell.Characters(Len(word) + idx, Len(cell.Value) - idx).Font.color = defaultColor
    End If
    
End Sub
 
'Использование:
Sub Test()
    SelectWord "Hallo, World!"
End Sub

@Ruella · 14.08.2018, 14:41

Baykal555, если Вы имеете в виду выделить одно конкретное слово в ячейках с многословным текстом, то можно как-то так, наверное:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Макрос1()
 
    Dim slovo As String, Rng As Range, Curr As Range, k As Integer
    
    Set Rng = ActiveSheet.Range("A1:C10")
    slovo = "Рубашка"
    For Each Curr In Rng.Cells
        k = Application.Search(slovo, Curr)
        If k > 0 Then
            Curr.Characters(Start:=k, Length:=Len(slovo)).Font.Color = vbGreen
        End If
    Next Curr
    
End Sub

Не по теме:

кажется, опоздала :)

@Baykal555 · 14.08.2018, 14:50 **[ТС]**

Ruella, пишет "Type mismatch"

@Ruella · 14.08.2018, 14:58

Baykal555, прошу прощения, в спешке не учла всех нюансов

попробуйте так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Макрос1()
 
    Dim slovo As String, Rng As Range, Curr As Range, k As Integer
    
    Set Rng = ActiveSheet.Range("A1:C10")
    slovo = "Рубашка"
    For Each Curr In Rng.Cells
        k = Application.IfError(Application.Search(slovo, Curr), 0)
        If k > 0 Then
            Curr.Characters(Start:=k, Length:=Len(slovo)).Font.Color = vbGreen
        End If
    Next Curr
    
End Sub

@Baykal555 · 14.08.2018, 15:32 **[ТС]**

Ruella, спасибо огромное!!!

Добавлено через 4 минуты
Ruella, а как прописать, если надо выделить не одно, а несколько слов?

@Ruella · 14.08.2018, 15:35

Baykal555, да не за что

скорее всего, это не самый оптимальный вариант, т.к. на скорую руку... но раз работает...

Добавлено через 3 минуты
Baykal555, в смысле, задано несколько контрольных слов, в тексте ячейки могут быть несколько из заданных, и выделить нужно каждое из них?

@Baykal555 · 14.08.2018, 15:37 **[ТС]**

Ruella, да, именно так

@Ruella · 14.08.2018, 16:02

Baykal555, попробуйте по тому же принципу. К примеру, перечень слов у нас находится в ячейках "F1:F4" (обзовем его Search). Тогда можно как-то так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Макрос1()
 
    Dim slovo As String, Search As Range, Rng As Range, CurrSearch As Range, CurrRng As Range, k As Integer
    
    Set Search = ActiveSheet.Range("F1:F4")
    Set Rng = ActiveSheet.Range("A1:C10")
    For Each CurrRng In Rng.Cells
        For Each CurrSearch In Search.Cells
            slovo = CurrSearch
            k = Application.IfError(Application.Search(slovo, CurrRng), 0)
            If k > 0 Then
                CurrRng.Characters(Start:=k, Length:=Len(slovo)).Font.Color = vbGreen
            End If
        Next CurrSearch
    Next CurrRng
    
End Sub

@Baykal555 · 15.08.2018, 11:07 **[ТС]**

Ruella, выделяется весь текст в ячейке, а нужно только одного слово.

@Ruella · 15.08.2018, 11:08

Baykal555, странно, у меня только конкретные слова вроде как выделялись... а файлик не скинете?

@Baykal555 · 15.08.2018, 11:12 **[ТС]**

Ruella,

@Ruella · 15.08.2018, 11:15

Baykal555, я уже, кажется, подозреваю, в чем дело

сейчас перепроверю на Вашем варианте

@Baykal555 · 15.08.2018, 11:16 **[ТС]**

Ruella, спасибо большое

@hamin · 15.08.2018, 11:41

Baykal555,

а попробовать ручками допилить мою функцию так, чтобы она для области ячеек работала никак?

@Ruella · 15.08.2018, 11:46

Baykal555, вроде готово. Как и предполагалось, в диапазоне поисковых слов имелись пустые ячейки. Excel реагирует на это таким вот странным образом

Если диапазон ограничить только ячейками с нужными словами, такой проблемы возникать не должно. Если все-таки необходимо указывать перечень слов в диапазоне с пустыми ячейками, то возможный выход - сначала подгрузить все слова из непустых ячеек диапазона в массив, а потом уже работать с ним.
Ну, и в Вашем варианте файла почему-то в каждой из ячеек имеются лишние пробелы в конце. Поэтому ключевое слово "Дом " в тексте "в доме", ясное дело, не найдется. Выход - или вручную поудалять конечные пробелы в диапазоне ключевых слов перед использованием макроса, либо в макросе дополнительно воспользоваться функцией Trim. Я пока что просто поубирала пробелы из ячеек. В таком виде вроде работает:

@Baykal555 · 15.08.2018, 11:58 **[ТС]**

Ruella, все равно выделяет все(

@Ruella · 15.08.2018, 12:01

Baykal555, блин, я криворукая

так и не подправила

в тексте макроса замените

Visual Basic
1
Set Search = ActiveSheet.Range("F1:F4")

на

Visual Basic
1
Set Search = ActiveSheet.Range("F1:F3")

ну, либо добавьте в F4 еще какое-нибудь слово

@hamin · 15.08.2018, 12:04

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub SelectWord(word As String, cell As Range, Optional color As Long = vbGreen, Optional defaultColor As Long = 0)
    
    Dim idx As Integer
    
    If cell Is Nothing Then Exit Sub
    
    idx = InStr(1, cell.Value, word)
    
    If idx <> 0 Then
        cell.Characters(1, idx - 1).Font.color = defaultColor
        cell.Characters(idx, Len(word)).Font.color = color
        cell.Characters(Len(word) + idx, Len(cell.Value) - idx).Font.color = defaultColor
    End If
    
End Sub
 
'?????????????:
Sub Test()
    Dim cell As Range
    
    For Each cell In Range("D3:E9")
        SelectWord "hallo", cell
    Next
End Sub

Новые блоги и статьи Все статьи Все блоги /
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. 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? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	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 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391

	Выделение слова в тексте 14.08.2018, 13:32. Показов 3214. Ответов 18 Метки нет (Все метки) Добрый день! Необходимо выделить определенные заранее известные слова в ячейке с текстом. Нужно чтобы было что-то вроде: Sub slovo() slovo = "Рубашка" If slovo in Range("A1:C10") then slovo.Interior.Color = vbGreen End If End Sub То есть программа находила слово "Рубашка" и выделяла его зеленым. Как это реализовать? Спасибо! 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	14.08.2018, 14:50 [ТС]
	Ruella, пишет "Type mismatch" 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	14.08.2018, 15:32 [ТС]
	Ruella, спасибо огромное!!! Добавлено через 4 минуты Ruella, а как прописать, если надо выделить не одно, а несколько слов? 0

@Ruella 472 / 161 / 80 Регистрация: 07.10.2015 Сообщений: 379
	14.08.2018, 15:35
	Baykal555, да не за что скорее всего, это не самый оптимальный вариант, т.к. на скорую руку... но раз работает... Добавлено через 3 минуты Baykal555, в смысле, задано несколько контрольных слов, в тексте ячейки могут быть несколько из заданных, и выделить нужно каждое из них? 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	14.08.2018, 15:37 [ТС]
	Ruella, да, именно так 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	15.08.2018, 11:07 [ТС]
	Ruella, выделяется весь текст в ячейке, а нужно только одного слово. 0

@Ruella 472 / 161 / 80 Регистрация: 07.10.2015 Сообщений: 379
	15.08.2018, 11:08
	Baykal555, странно, у меня только конкретные слова вроде как выделялись... а файлик не скинете? 0

@Ruella 472 / 161 / 80 Регистрация: 07.10.2015 Сообщений: 379
	15.08.2018, 11:15
	Baykal555, я уже, кажется, подозреваю, в чем дело сейчас перепроверю на Вашем варианте 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	15.08.2018, 11:16 [ТС]
	Ruella, спасибо большое 0

@hamin 880 / 559 / 291 Регистрация: 21.11.2012 Сообщений: 1,553
	15.08.2018, 11:41
	Baykal555, а попробовать ручками допилить мою функцию так, чтобы она для области ячеек работала никак? 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	15.08.2018, 11:58 [ТС]
	Ruella, все равно выделяет все( 0

Выделение слова в тексте

Решение