Mejorar sentencia para formato normal en VBA

Para Dante Amor. Tengo una sentencia que con tus aportes pude elaborar, sin embargo esta muy larga y pensaba si me puedes apoyar en darle un vistazo y saber si se puede hacer más corta. De antemano te agradezco el apoyo y si aceptas apoyarme te puedo mandar mi archivo o me indiques como pegar la sentencia de la forma que tu envías los códigos cuando respondes.

1 Respuesta

Respuesta
2

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

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas