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

Question

У меня есть фиксированный набор значений (0%, 20%, 40%, 60%, 80% и 100%) в столбце Е.

Если я заполню ячейку в столбце E любым из указанных выше значений, ячейка G должна выбрать форматирование из другой ячейки.

Например,

if I fill 0 in E3, the cell G3 should pick formatting from H3
if I fill 20 in E3, the cell G3 should pick formatting from H3
if I fill 40 in E3, the cell G3 should pick formatting from I3
if I fill 60 in E3, the cell G3 should pick formatting from J3
if I fill 80 in E3, the cell G3 should pick formatting from K3
if I fill 100 in E3, the cell G3 should pick formatting from L3

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

Answer 1

В качестве иллюстрации ниже приведен простой макрос VBA, который выполняет форматирование. Вам решать, будет ли это просто. Нечто подобное можно поместить в подпрограмму события Worksheet_Change.

Это немного более гибко, чем условное форматирование, потому что вы можете иметь разные форматы в каждой строке столбца, из которого вы выбираете формат. (например, см. столбец H в шапке экрана).

Вот снимок экрана рабочего листа перед запуском макроса ...

А вот снимок экрана после запуска макроса ...

А вот и код VBA ...

Sub FormatTransfer()
Dim mySht As Worksheet
Dim myInRng As Range, myOutRng As Range, myFmtRng As Range
Dim myCell As Range

Set mySht = Worksheets("Sheet3")
Set myInRng = mySht.Range("E1", mySht.Range("E" & mySht.Rows.Count).End(xlUp))
Set myOutRng = myInRng.Offset(0, 2)
Set myFmtRng = mySht.Range(myInRng.Offset(0, 3), myInRng.Offset(0, 7))

For Each myCell In myInRng
    If myCell.Value < 20# Then
        myFmtRng(myCell.Row, 1).Copy
        myOutRng(myCell.Row, 1).PasteSpecial xlPasteFormats
    End If
    If myCell.Value >= 20# And myCell.Value < 40# Then
        myFmtRng(myCell.Row, 1).Copy
        myOutRng(myCell.Row, 1).PasteSpecial xlPasteFormats
    End If
    If myCell.Value >= 40# And myCell.Value < 60# Then
        myFmtRng(myCell.Row, 2).Copy
        myOutRng(myCell.Row, 1).PasteSpecial xlPasteFormats
    End If
    If myCell.Value >= 60# And myCell.Value < 80# Then
        myFmtRng(myCell.Row, 3).Copy
        myOutRng(myCell.Row, 1).PasteSpecial xlPasteFormats
    End If
    If myCell.Value >= 80# And myCell.Value <= 100# Then
         myFmtRng(myCell.Row, 4).Copy
         myOutRng(myCell.Row, 1).PasteSpecial xlPasteFormats
   End If
Next myCell

End Sub