Условное форматирование с использованием VBA, динамическое моделирование диапазона путем обращения к другой ячейке для форматирования

Question

Вот моя проблема.

Таким образом, применительно к диапазону K3:K10, у меня есть несколько различных правил условного форматирования, которые требуют конкретной текстовой строки, состоящей из содержимого ячейки ссылочного плюса постоянной текстовой строки. Каждое правило применяет другой цвет для конкретной ссылки и константной текстовой строки (DEAD или ALIVE). Например, в диапазоне, если ячейка содержит слово «собака», затем пробел, а затем слово «мертвый», оно будет отформатировано красным. В легенде в колонках D и E показано, какие цвета применяются к каждому животному для комбинации критериев (Animal and Dead/Alive). То, что я хочу сделать, - это выбрать цвет для животного с выпадающим списком в столбце C и изменить CF форматирование любой из ячеек в диапазоне K3:K10 в соответствии с форматированием/стилем соответствующая строка в столбце C, когда определенное правило является истинным.

Итак, если K3 является «Dog Dead», а затем применить такое же форматирование, как в ячейке D3 или, если это «Собака Alive» применить такое же форматирование, как E3. Я не хочу просто просить CF сделать любую ячейку, содержащую «Dog Dead» или «Dog Alive», светло-красный, потому что цвет для собаки может быть не красным. Это может быть зеленый или синий.

Итак, я думаю, что хочу добиться динамического условного форматирования с помощью VBA, я думаю. Может кто-нибудь помочь мне начать?

Thanks,

Andy.

Answer 1

Отправная точка !!
В случае Sheet:

Private Sub Worksheet_Change(ByVal Target As Range) 
    ApplyCond Range("K" & Target.Row) 
End Sub 

А в модуле:

Public Sub ApplyCond(xx As Range) 
    If xx.Value = "" Then Exit Sub 
    xx.FormatConditions.Delete 
    xx.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _ 
     Formula1:=xx.Value 
    kk = Split(xx.Value) 
    a = -1 
    b = -1 
    For i = LBound(kk) To UBound(kk) 
     Select Case kk(i) 
     Case "Dead": a = 4 
     Case "Alive": a = 5 
     Case Else 
      For e = 3 To 9999 
       If Range("B" & e).Value = "" Then Exit For 
       If Range("B" & e).Value = kk(i) Then 
        b = e 
       End If 
      Next 
     End Select 
    Next 

    ' Apply Format 
    On Error Resume Next 
    If (a > 0) And (b > 0) Then 
     With xx.FormatConditions(1).Interior 
      .PatternColorIndex = Cells(b, a).Interior.PatternColorIndex 
      .Color = Cells(b, a).Interior.Color 
      .TintAndShade = Cells(b, a).Interior.TintAndShade 
      .Pattern = Cells(b, a).Interior.Pattern 
      .PatternThemeColor = Cells(b, a).Interior.PatternThemeColor 
      .ThemeColor = Cells(b, a).Interior.ThemeColor 
      .PatternTintAndShade = Cells(b, a).Interior.PatternTintAndShade 
     End With 
     With xx.FormatConditions(1).Font 
      .Bold = Cells(b, a).Font.Bold 
      .Italic = Cells(b, a).Font.Italic 
      .Underline = Cells(b, a).Font.Underline 
      .Strikethrough = Cells(b, a).Font.Strikethrough 
      .ThemeColor = Cells(b, a).Font.ThemeColor 
      .TintAndShade = Cells(b, a).Font.TintAndShade 
      .Color = Cells(b, a).Font.Color 
      .TintAndShade = Cells(b, a).Font.TintAndShade 
     End With 
    End If 
End Sub 

Вы должны проверить Разделить формулу. Возможно, лучше использовать функцию LCase или другой фильтр.
В моей функции я не использую столбец «C».