FUNCIÓN VBA: Insertar símbolo "Aceptado" o "Rechazado" a celda, dependiendo de cuál es el valor más alto
Desde Chile:
Estoy desarrollando un sistema de horario para ocupar en mis actividades, pero me encontré con problemita: Debo insertar el símbolo "✔" al costado de la celda de mayor valor y el símbolo "✘" a la celda de menor valor. Hasta ahora he utilizado el siguiente código, el cual debo instanciar desde el evento "WorkSheet_Activate", lo cual deja demasiado lento el archivo, utilizando el siguiente código:
Public Sub VerificaEstado()
If Sheets("ACTIVIDADES").Range("J11") > Sheets("ACTIVIDADES").Range("J15") Then
Sheets("ACTIVIDADES").Range("K11").Select
Selection.FormulaR1C1 = "R"
Selection.Font.Color = RGB(84, 130, 53)
Else
Sheets("ACTIVIDADES").Range("K11").Select
Selection.FormulaR1C1 = "Q"
Selection.Font.Color = RGB(250, 0, 0)
End If
Selection.Font.Name = "Wingdings 2"
Selection.Font.Bold = True
' --------------------- PARTE DOS ---------------------
If Sheets("ACTIVIDADES").Range("J11") < Sheets("ACTIVIDADES").Range("J15") Then
Sheets("ACTIVIDADES").Range("K15").Select
Selection.FormulaR1C1 = "R"
Selection.Font.Color = RGB(84, 130, 53)
Else
Sheets("ACTIVIDADES").Range("K15").Select
Selection.FormulaR1C1 = "Q"
Selection.Font.Color = RGB(250, 0, 0)
End If
Selection.Font.Name = "Wingdings 2"
Selection.Font.Bold = True
End Sub
En la imagen se puede observar en un intento de círculo azul, cómo funciona el código anterior, cumpliendo sin problemas su objetivo, pero que debido a su estructura, me limita a utilizarlo solo en los rangos especificados. Mi idea es poder usarlo en forma de una función con parámetros que pasar y que de esta forma sea más funcional.
1 Respuesta
Te dejo un posible código (que deberías ver luego como lo activas para que se ejecute)...
Fijate que comp1 y comp2 son las celdas que estás comparando los valores y flagRight es para indicar si las marcas las pone a la derecha de las celdas o debajo de ellas...
Public Sub VerificaEstado(comp1 As Range, comp2 As Range, flagRight As Boolean) 'flagRight: si es verdadero, coloca los símbolos a la derecha de los valores a comparar, en caso contrario 'los coloca debajo Dim desp As Byte desp = IIf(flagRight, 1, 0) If comp1 > comp2 Then comp1.Offset(1 - desp, desp).FormulaR1C1 = "R" comp1.Offset(1 - desp, desp).Font.Color = RGB(84, 130, 53) comp2.Offset(1 - desp, desp).FormulaR1C1 = "Q" comp2.Offset(1 - desp, desp).Font.Color = RGB(250, 0, 0) Else comp2.Offset(1 - desp, desp).FormulaR1C1 = "R" comp2.Offset(1 - desp, desp).Font.Color = RGB(84, 130, 53) comp1.Offset(1 - desp, desp).FormulaR1C1 = "Q" comp1.Offset(1 - desp, desp).Font.Color = RGB(250, 0, 0) End If comp1.Offset(1 - desp, desp).Font.Name = "Wingdings 2" comp1.Offset(1 - desp, desp).Font.Bold = True comp2.Offset(1 - desp, desp).Font.Name = "Wingdings 2" comp2.Offset(1 - desp, desp).Font.Bold = True End Sub
¡Gracias! Veré cómo funciona, una vez que pueda volver a ver mi archivo de Excel. Te comento cómo me fue cuando tenga alguna noticia al respecto.
Gustavo Omar Fellay No me aguanté la curiosidad y me puse a implementar el código, pero le cambié de Sub a Function, ya que debía pasar los parámetros y no funcionó; tal vez no estoy entendiendo el booleano "FlagRight" o algo por el estilo. Espero me puedas proporcionar más información sobre el funcionamiento de tu código.
Muchas Gracias.
La lógica de lo que puse te va a servir, pero hay que hacer algunos ajustes porque así como está directamente no te va a servir. Recuerda que las funciones devuelven un valor y este no sería el caso...