Código VBA de Macro que no ejecuta lo requerido al no detectar cambios en las columnas b c y e simultáneamente
Estimada red tengo este problema les pego el código;
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fila As Integer
Dim caso As Integer
fila = Target.Row
If Target.Column = 2 Then
If Target.Value = "" Then
caso = 1
Else
If Target.Value <> 0 Then
caso = 2
End If
End If
Select Case caso
Case 1 'celda vacia
Range("d" & fila).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("d" & fila).Value = ""
Range("D" & fila).Select
Selection.NumberFormat = "0.00%"
Case 2
If Range("b" & fila).Value > 0 Then
Range("d" & fila).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("d" & fila).Value = "=RC[-1]/RC[-2]"
Range("D" & fila).Select
Selection.NumberFormat = "0.00%"
Else
Range("D" & fila).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("D" & fila).Value = "NO SE PUEDE DETERMINAR EL INDICADOR"
End If
End Select
Range("D" & fila + 1).Select
End If
End Sub
Private Sub Worksheet_Change2(ByVal Target As Range)
Dim fila As Integer
Dim caso As Integer
fila = Target.Row
If Target.Column = 3 Then
If Target.Value = "" Then
caso = 1
Else
If Target.Value <> 0 Then
caso = 2
End If
End If
Select Case caso
Case 1 'celda vacia
Range("d" & fila).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("d" & fila).Value = ""
Range("D" & fila).Select
Selection.NumberFormat = "0.00%"
Case 2
If Range("C" & fila).Value > 0 Then
Range("d" & fila).Select
Range("f" & fila).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("d" & fila).Value = "=RC[-1]/RC[-2]"
Range("D" & fila).Select
Selection.NumberFormat = "0.00%"
Range("f" & fila).Value = "=RC[-3]/RC[-1]"
Range("f" & fila).Select
Selection.NumberFormat = "0.00%"
Else
Range("D" & fila).Select
Range("f" & fila).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("D" & fila).Value = "NO SE PUEDE DETERMINAR EL INDICADOR"
Range("f" & fila).Value = "NO SE PUEDE DETERMINAR EL INDICADOR"
End If
End Select
Range("D" & fila + 1).Select
Range("f" & fila + 1).Select
If Target.Column = 5 Then
If Target.Value = "" Then
caso = 1
Else
If Target.Value <> 0 Then
caso = 2
End If
End If
Select Case caso
Case 1 'celda vacia
Range("f" & fila).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("f" & fila).Value = ""
Range("f" & fila).Select
Selection.NumberFormat = "0.00%"
Case 2
If Range("E" & fila).Value > 0 Then
Range("f" & fila).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("f" & fila).Value = "=RC[-3]/RC[-1]"
Range("f" & fila).Select
Selection.NumberFormat = "0.00%"
Else
Range("f" & fila).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("f" & fila).Value = "NO SE PUEDE DETERMINAR EL INDICADOR"
End If
End Select
Range("f" & fila + 1).Select
End If
End Sub
Básicamente lo que debería hacer el código, es que si algún valor dentro de las celdas de las columnas b o c o e---cambian, deberían detectar esos cambios y aplicar las fórmulas correspondientes en las celdas de las columnas d y f. En las celdas de la columna d, la fórmula seria el cociente entre los valores de las celdas "c/b" y en las celdas de la columna "f", esta debería arrojar el valor resultante de dividir los valores de la celdas de columna c por los de "e" ---c/e.
Espero que puedan ayudarme ya que en esto de programar soy de madera
1 respuesta
Te anexo el código, tal vez falta afinar algo en los colores, pero prueba el funcionamiento de las operaciones y me comentas.
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Row < 3 Then Exit Sub
fila = Target.Row
If Not Intersect(Target, Range("B:C")) Is Nothing Then
If Target.Value = "" Or Target.Value = 0 Then
Cells(fila, "D").Value = ""
Cells(fila, "D").Interior.Color = 255
Else
If Cells(fila, "B").Value <> "" And Cells(fila, "C").Value <> "" Then
Cells(fila, "D").Value = Cells(fila, "C").Value / Cells(fila, "B").Value
Cells(fila, "D").Interior.Color = 5296274
Cells(fila, "D").NumberFormat = "0.00%"
End If
End If
End If
'
If Not Intersect(Target, Columns("E")) Is Nothing Then
If Target.Value = "" Or Target.Value = 0 Then
Cells(fila, "F").Value = ""
Cells(fila, "F").Interior.Color = 255
Else
If Cells(fila, "C").Value <> "" And Cells(fila, "E").Value <> "" Then
Cells(fila, "F").Value = Cells(fila, "C").Value / Cells(fila, "E").Value
Cells(fila, "F").Interior.Color = 5296274
Cells(fila, "F").NumberFormat = "0.00%"
End If
End If
End If
End Sub.
.
