Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.09.2019, 13:01   #1
wsashw
 
Регистрация: 09.09.2019
Сообщений: 7
По умолчанию Нужно расширить действие макроса до 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 Кб, 16 просмотров)

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

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

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

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

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

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


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