Как наложить условно отформатированную тепловую карту на основе одного набора значений на другой набор значений в Excel 2013

Question

Я хотел бы, чтобы одна ячейка была отформатирована с градиентным цветом на основе значения в другой ячейке. Например, я хотел бы, чтобы ячейки A1 и A2 были выделены на основе значений в B1 и B2 . Если я выберу подсветку от красного к желтому к зеленому (т. Е. "Цветовые шкалы" в "Условном форматировании") в Excel, я ожидаю, что если B1 = 1 и B2 = 2 то A1 будет выделен красным, а A2 будет выделен зеленым. По сути, я хочу построить тепловую карту с одним набором значений в таблице и наложить эту тепловую карту на отдельную таблицу значений одинакового размера.

Я видел множество постов, обсуждающих, как получить ячейку, отформатированную не динамическим способом на основе другой ячейки (например, здесь и здесь), но я не могу найти описание того, как сделать то, что я хочу сделать здесь. Является ли это возможным?

Если невозможно установить формулу для этого, я был бы рад скопировать цвета цветовой шкалы в B1:B2 в A1:A2 , но я также не могу найти способ сделать это.

Answer 1

Это должно работать, когда вы вставляете его в Developer -> Visual Basic , под листом, на котором вы работаете. Обязательно измените диапазон.

Sub Worksheet_Change(ByVal Target As Range)
    Set Rng = Range("A1:B2")
    If Application.Intersect(rng1, rng2) Is Not Nothing Then
        Dim Min, Max, Index As Double
        Dim Red, Green As Integer
        Dim Cell As Range
        Dim Rng As Range
        Min = Minimum(Rng)
        Max = Maximum(Rng)
        For Each Cell In Rng
            Index = (Cell.Value - Min) / (Max - Min)
            Red = 255 * ListMin(1, 2 - 2 * Index)
            Green = 255 * ListMin(1, 2 * Index)
            Cell.Offset(RowOffset, ColumnOffset).Interior.Color = RGB(Red, Green, 0)
        Next Cell
    End If
End Sub
Function Maximum(Cells As Range)
    Maximum = Application.WorksheetFunction.Max(Cells)
End Function
Function Minimum(Cells As Range)
    Minimum = Application.WorksheetFunction.Min(Cells)
End Function
Function ListMax(ParamArray Values() As Variant)
    ListMax = Application.WorksheetFunction.Max(Values)
End Function
Function ListMin(ParamArray Values() As Variant)
    ListMin = Application.WorksheetFunction.Min(Values)
End Function

Большая часть этого должна быть достаточно понятной, не стесняйтесь комментировать, если у вас есть какие-либо вопросы.