Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 09.09.2019, 14:01   #1
wsashw
Новичок
 
Регистрация: 09.09.2019
Сообщений: 2
Репутация: 10
По умолчанию Нужно расширить действие макроса до active листа

Доброго времени суток, уважаемые гуру VBA!

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

Есть макрос (во вложении), который производит поиск введенного в msgBox значения (всех его копий) и красит найденное в красный с выделением жирным.

Макрос работает в диапазоне столбца "А".

Задача: что бы работал в диапазоне активного листа.

Прошу вашей помощи и заранее благодарю!

Вот код макроса:

Код:
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
______________________
Используйте тег [CODE] (кнопка [CODE] в форме сообщения) при вставке кода на форум. Подробнее в FAQ
_____________
Вложения
Тип файла: xls HighlightText draft.xls (53.0 Кб, 11 просмотров)

Последний раз редактировалось Serge_Bliznykov; 09.09.2019 в 15:30.
wsashw вне форума   Ответить с цитированием
Старый 09.09.2019, 15:23   #2
Hugo121
Профессионал
 
Регистрация: 11.05.2010
Сообщений: 5,033
Репутация: 464
По умолчанию

Он и так должен работать в активном листе, если код будет не в модуле какого-то определённого листа, а в стандартном модуле.
Но файл не смотрел, код не тестировал - может там какие ошибки и не заметил...
__________________
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума   Ответить с цитированием
Старый 09.09.2019, 15:34   #3
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 25,830
Репутация: 5617
По умолчанию

Цитата:
Сообщение от wsashw Посмотреть сообщение
Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)) ' диапазон для поиска
замените эту строчку на нужный диапазон.

например,
Код:
Set ra = ActiveSheet.UsedRange
p.s. не проверял
Serge_Bliznykov вне форума   Ответить с цитированием
Старый 09.09.2019, 20:09   #4
wsashw
Новичок
 
Регистрация: 09.09.2019
Сообщений: 2
Репутация: 10
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
замените эту строчку на нужный диапазон.

например,
Код:
Set ra = ActiveSheet.UsedRange
p.s. не проверял
Спасибо, огромное!
Все получилось.
wsashw вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Чем обусловлено разное действие одного и того же макроса в разных файлах? Oleg_123 Microsoft Office Excel 28 08.07.2017 20:07
Запуск макроса с другого листа. Mag0G Microsoft Office Excel 14 26.02.2016 17:57
Отменить действие макроса в функции If ольгаг Microsoft Office Excel 2 12.12.2015 00:10
Защита листа с помощью макроса amadeus017 Microsoft Office Excel 6 25.03.2015 19:03
Как перейти из макроса Книги в макрос листа valerij Microsoft Office Excel 15 30.04.2011 01:51


02:43.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.