mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Поиск заданного текста в ячейках, с подсветкой найденных вхождений

Поиск и подсветка результатов в Excel

Макрос запрашивает строку для поиска, после чего ищет введенный текст в первом столбце листа, и подсвечивает результаты поиска.

 

При запуске макроса появляется диалоговое окно (InputBox), позволяющее задать текст для поиска.

Макрос подсвечивает красным цветом внутри ячейки текст, совпадающий с искомым
(+ выделяет найденное полужирным начертанием)

Перед началом поиска, цвет всех ячеек первого столбца сбрасывается (на черный)

 

Option Compare Text
 
Sub Find_n_Highlight()
    On Error Resume Next: Err.Clear
    Dim ra As Range, cell As Range, res, txt$, v, pos&
    res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "диз")
    If VarType(res) = vbBoolean Then Exit Sub    ' нажата кнопка ОТМЕНА
    txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub    ' текст не введен, или состоит из пробелов

    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))    ' диапазон для поиска
    Application.ScreenUpdating = False
    ra.Font.Color = 0: ra.Font.Bold = 0  ' сброс цветового выделения

    For Each cell In ra.Cells    ' перебираем все ячейки
        pos = 1
        If cell.Text Like "*" & txt & "*" Then
            arr = Split(cell.Text, txt, , vbTextCompare)   ' разбивает текст ячейки на части
            If UBound(arr) > 0 Then    ' если подстрока найдена
                For Each v In arr    ' перебираем все вхождения
                    pos = pos + Len(v)    ' начальная позиция
                    With cell.Characters(pos, Len(txt))
                        .Font.ColorIndex = 3    ' выделяем цветом
                        .Font.Bold = True    ' и полужирным начертанием
                    End With
                    pos = pos + Len(txt)
                Next v
            End If
        End If
    Next cell
End Sub

ВложениеРазмерЗагрузкиПоследняя загрузка
HighlightText.zip14.63 КБ42 года 50 недель назад

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Прокомментируйте, пожалуйста, эту строку
Dim ra As Range, cell As Range, res, txt$, v, pos&

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

Здравствуйте, Татьяна. Код - не очень сложный. Для меня вообще ничего сложного нет.
Можем сделать под заказ. А если надо бесплатно, - обратитесь на форумы по Excel, там помогут.

Здравствуйте! А можно ли например если искать кусочек "воп" то вывести список всех слов с "воп"? или это сложный код?

Валерий, конечно я принимаю заказы.
На сайте ведь есть кнопка «Оформить заказ»...

Еще заказы принимаете?

Здравствуйте
Это совсем другой макрос нужен
Можно сделать под заказ (мы берем заказы на сумму от 1000 рублей)

Спасибо!
А не могли бы помочь как на основе(а можно и не на основе) этого кода сделать макрос такой.
Искать значения(слово) из столбца F( в нем искомое слово, строк множество пока не станет пусто) в столбце A(возможно несколько повторений искомого текста) и если находит, то брать значение соответствующей ячейки этой строки в столбце G(строка та же что и искомое слово) и подставлять в соответствующую ячейку B(правее ячейки из A). И зациклить пока все слова из F не будут найдены в A и подставлены значения из G.
Небольшая благодарность не заставит себя ждать :)

Здравствуйте, Влад.
Сделать можно все что угодно, - но только под заказ.
Потому что идей у пользователей много, а у меня свободного времени - намного меньше)

Хорошая задумка, но ещё было бы гибче работа в таком формате.
1. Было бы альтернативное окно, в котором можно ввести список (допустим до 1000 значений, либо без ограничений) для массовой подсветки.

2. Предусмотреть поиск не по частичному совпадению, а полному. Например, в массиве указано отчество ВИКТОРОВИЧ, а ищем ВИКТОР. Следовательно, если ВИКТОР не найден, тогда отчество остается не подсвеченным.

Мысли вслух.

Хотел отблагодарить, но не вижу как. Дайте кошелек пожалуйста.

Вывел в виде кнопок на ленту: поиск по А - сброс, поиск по В - сброс.
Для работы с сем. ядром для сайта - самое то. Спасибо огромное!

Можно и так сделать. Любой каприз за ваши деньги)

Вот было бы супер, если бы окошко не пряталось, и в нем была кнопка "сбросить подсветку"

Сброс подсветки выполняется легко, - достаточно выделить первый столбец, поставить «цвет текста» = автоматически, и отжать кнопку «Ж»

В виде макроса (для первого столбца) это будет выглядеть так:

Sub СнятьПодсветку()
    Range("a:a").Font.Bold = False
    Range("a:a").Font.ColorIndex = xlColorIndexAutomatic
End Sub

Класс! Спасибо большое!
Хорошо бы еще макрос, который будет сбрасывать подсветку.

Макрос ищет и подсвечивает искомый текст только в первом столбце
(в диапазоне ячеек с A2 до последней заполненной ячейки в столбце A)
А у вас, возможно, данные в другом столбце расположены.

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

То что нужно. Спасибо большое!
PS только почему то мою тему на планете эксель удалили.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _____           ___   _____      _      ____  
| ___| __ __ |_ _| | ____| / \ / ___|
| |_ \ \ / / | | | _| / _ \ \___ \
| _| \ V / | | | |___ / ___ \ ___) |
|_| \_/ |___| |_____| /_/ \_\ |____/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.