Te anexo la macro
Private Sub Worksheet_Change(ByVal Target As Range)
'CALCULA LA MAGNITUD DE RIESGOS DE CADA ESCENARIO REGISTRADO INHERENTE
If Not Intersect(Target, Range("A2:E51")) Is Nothing Then
If Target.Count > 100 Then Exit Sub
For Each c In Target
i = c.Row
If Cells(i, "A") = "" Then
Cells(i, "G").Value = ""
Cells(i, "H").Value = ""
Cells(i, "I").Value = ""
Cells(i, "J").Value = ""
Cells(i, "K").Value = ""
Else
Cells(i, "G").Value = (Cells(i, "A") * Cells(i, "B"))
Cells(i, "H").Value = (Cells(i, "A") * Cells(i, "C"))
Cells(i, "I").Value = (Cells(i, "A") * Cells(i, "D"))
Cells(i, "J").Value = (Cells(i, "A") * Cells(i, "E"))
Cells(i, "K").Value = (Cells(i, "A") * Cells(i, "B")) + (Cells(i, "A") * Cells(i, "C")) + (Cells(i, "A") * Cells(i, "D")) + (Cells(i, "A") * Cells(i, "E"))
Select Case Cells(i, "K").Value
Case 1 To 19: Cells(i, "K").Interior.Color = 65280
Case 20 To 47: Cells(i, "K").Interior.Color = 65535
Case 48 To 76: Cells(i, "K").Interior.Color = 49407
Case 77 To 144: Cells(i, "K").Interior.Color = 255
End Select
'
Call PonerColor(i, "B")
Call PonerColor(i, "C")
Call PonerColor(i, "D")
Call PonerColor(i, "E")
End If
Next
End If
End Sub
'
Sub PonerColor(i, col)
Select Case Val(Cells(i, "A") & Cells(i, col))
Case 11, 21, 31, 41, 12, 22, 14, 15
Cells(i, col).Interior.Color = 65280
Case 51, 61, 32, 42, 52, 23, 33, 43, 24, 34, 15, 25, 16
Cells(i, col).Interior.Color = 65535
Case 62, 53, 54, 44, 45, 35, 26
Cells(i, col).Interior.Color = 49407
Case 63, 64, 65, 55, 66, 56, 46, 36
Cells(i, col).Interior.Color = 255
End Select
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.