Заливка ячейки по критериям

Старая форма входа

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

Заливка ячейки по критериям (Макросы/Sub)

tre208

Дата: Суббота, 26.11.2022, 21:00 | Сообщение № 1

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

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

Сообщений: 3

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

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

Доброго времени суток, специалисты макросов!
Прошу Вашей помощи в решении проблемы. В макросах не силен.

Необходимо окрасить ячейки на Лист1 в колонке F по критериям, которые находятся на Лист2 в колонке А.
Каждый раз применять фильтр и окрашивать вручную долго. Критериев может быть от 1 до 1000.
Заранее благодарен за помощь!
Пример прикладываю

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

Ответить

cmivadwot

Дата: Воскресенье, 27.11.2022, 01:22 | Сообщение № 2

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

Ранг: Ветеран

Сообщений: 533

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

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

365

tre208, Добр. через условное форматирование

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

Сообщение отредактировал cmivadwot - Воскресенье, 27.11.2022, 01:54

Ответить

Kuzmich

Дата: Воскресенье, 27.11.2022, 18:35 | Сообщение № 3

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

Ранг: Ветеран

Сообщений: 713

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

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

Excel 2003

Цитата

окрасить ячейки на Лист1 в колонке F

Каждый город своим цветом
[vba]

Код

Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim FoundTown As Range
Dim FAdr As String
Dim List_1 As Worksheet
Dim List_2 As Worksheet
   Set List_1 = ThisWorkbook.Worksheets("Ëèñò1")
   Set List_2 = ThisWorkbook.Worksheets("Ëèñò2")
iLastRow = List_1.Range("F1").End(xlDown).Row
List_1.Range("F1:F" & iLastRow).Interior.ColorIndex = 2
  iLR = List_2.Range("A1").End(xlDown).Row
  For i = 2 To iLR
    Set FoundTown = List_1.Range("F1:F" & iLastRow).Find(List_2.Cells(i, "A"), , xlValues, xlWhole)
    FAdr = FoundTown.Address
    Do
        FoundTown.Interior.ColorIndex = i + 1
      Set FoundTown = List_1.Range("F1:F" & iLastRow).FindNext(FoundTown)
    Loop While FoundTown.Address <> FAdr
  Next
End Sub

[/vba]