Закрашивание ячеек макросом

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Закрашивание ячеек макросом (Макросы/Sub)

Alexander5777

Дата: Среда, 02.07.2025, 20:59 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Добрый вечер!
Прошу Вашей помощи в написании макроса, поскольку новичек в макросах
Макрос должен закрасить ячейки на Лист1 которые содержат слова из Лист2.
УФ не удобно пользоватся поскольку количество строк на Лист2 меняется.
Количество строк на Лист1 может доходить до 900 тис.
Заранее благодарен!)

К сообщению приложен файл: uf.xlsx (9.4 Kb)

Ответить

WowGun

Дата: Среда, 02.07.2025, 23:41 | Сообщение № 2

Группа: Проверенные

Ранг: Новичок

Сообщений: 48

Репутация: 20 ±

Замечаний: 0% ±

Excel 2016

Возможно так подойдет.

К сообщению приложен файл: uf_2.xlsm (17.4 Kb)

УЧИТЕСЬ ... спрашивать.

Сообщение отредактировал WowGun - Четверг, 03.07.2025, 01:20

Ответить

msi2102

Дата: Четверг, 03.07.2025, 11:54 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 430

Репутация: 131 ±

Замечаний: 0% ±

Excel 2007

WowGun, Вы забыли в конце поставить
[vba]

Код

Application.ScreenUpdating = True

[/vba]
Можно ещё таким макросом
[vba]

Код

Sub Макрос3()
    Dim rng1 As Range, rng2 As Range
    Application.ScreenUpdating = False
    Set sd = CreateObject("Scripting.Dictionary")
    Set rng2 = Worksheets("Лист2").Range("A2:A" & Worksheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row)
    Set rng1 = Worksheets("Лист1").Range("A2:A" & Worksheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row)
    rng1.Interior.Pattern = xlNone
    For Each n In rng2
        If Not sd.Exists(n.Value) Then sd.Add n.Value, n.Value
    Next
    For Each n In rng1
        If sd.Exists(n.Value) Then n.Interior.Color = 1243494
    Next
    Application.ScreenUpdating = True
End Sub

[/vba]