Developing.ru

Код: Выделить всё

По сути, макрос Worksheet_Change дублирует функцию условного форматирования Excel. Увеличение максимального числа условий достигается за счет наличия управляющего листа, содержащего 2 столбца допустимых значений ячеек (столбец A) и соответствующих индексов цвета заливки (столбец B).
Private Sub Worksheet_Change(ByVal Target As Range)
' Этот макрос реализует условное форматирование
' с более чем 3-мя условиями.
Dim rng As Range
' Исходный диапазон может содержать более чем 1 ячейку,
' поскольку он задается как пересечение диапазонов Target
' и D:D. Благодаря этому макрос будет выполняться корректно
' при удалении содержимого нескольких ячеек столбца D или
' вводе значений нескольких ячеек столбца D в виде массива.
Set rng = Intersect(Target, Range("D:D"))
If rng Is Nothing Then
Exit Sub
Else
Dim cl As Range
For Each cl In rng
On Error Resume Next
' Если содержимое ячейки отсутствует
' в диапазоне rngColors, ее заливка удаляется.
cl.Interior.ColorIndex = _
Application.WorksheetFunction.VLookup(cl.Value, _
ThisWorkbook.Sheets("УФ (управляющий лист)").Range("rngColors"), _
2, False)
If Err.Number <> 0 Then
cl.Interior.ColorIndex = xlNone
End If
Next cl
End If
End Sub