Fórmula ou VBA para formatação de célula usando valor baseado em uma célula, mas formatando de outra célula

Question

Eu tenho um conjunto fixo de valores, (0%, 20%, 40%, 60%, 80% e 100%) na coluna E.

Se eu preencher uma célula na coluna E com qualquer um dos valores acima, a célula G deve escolher a formatação de outra célula.

Por exemplo,

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

Eu sei que isso pode ser feito em uma série de formatação condicional, mas é um pouco difícil fazê-lo. Além disso, queria ver se há uma resposta simples?

    

Answer 1

Assim como a ilustração, abaixo está uma macro VBA simples que faz a formatação. Cabe a você decidir se é simples. Algo semelhante poderia ser colocado no sub-item do evento Worksheet_Change.

Isso é um pouco mais flexível do que a formatação condicional, porque você pode ter diferentes formatos em cada linha da coluna da qual você escolheu o formato. (por exemplo, veja a coluna H no limite da tela).

Aqui está uma captura de tela da planilha antes de executar a macro ...

Eaquiestáumacapturadeteladepoisdeexecutaramacro...

EaquiestáocódigodoVBA...

SubFormatTransfer()DimmyShtAsWorksheetDimmyInRngAsRange,myOutRngAsRange,myFmtRngAsRangeDimmyCellAsRangeSetmySht=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