RESALTAR VALORES SUPERIORES E INFERIORES EN COLUMNAS INDEPENDIENTES

Hace unos días un lector del blog me trasladó un nueva consulta relacionada con la posibilidad de marcar o resaltar  X valores superiores o inferiores en varias columnas.

Rápidamente le indiqué que esto podría realizarlo perfectamente con el botón del formato condicional, que se encuentra en la cinta de opciones en el menú de Inicio. Usando esta herramienta se podría ahorrar realizar un programa dado que Excel ya tiene esta opción integrada. Pero la respuesta es que lo necesitaba con código, que lo quería unir a otra macro que ya había realizado y así podía unir varios procesos.

Por lo tanto, y siguiendo con lo comentado, he ideado un ejemplo donde podremos ver una macro aplicada para detectar y marcar los «n» valores más altos o bajos.

Imaginad que tenéis los datos de facturación de vuestro negocio distribuido por días y a su vez por horas. Dado que nuestro negocio ha resultado ser un verdadera mina de oro, tenemos grandes ingresos durante todo el día y es que además trabajamos las 24 horas. Los datos serían estos:

Lo primero que queremos obtener y resaltar son los, por ejemplo, 4 importes más altos por día, es decir, por columna. Para ello vamos a utilizar el siguiente código:

Sub TopX()
'----------------------------------------------------------------------------
'MARCAR LAS X PRIMERAS CIFRAS
'----------------------------------------------------------------------------
Dim i As Double
Application.ScreenUpdating = False
'Antes de comenzar debemos determinar el ranking que vamos a asignar,
'en este caso establecemos el valor en las "N" menores cifras.
If Worksheets("Hoja1").Range("K4").Value < "1" Then
MsgBox ("INDICA UN NUMERO DE VALORES QUE DETERMINEN EL RANKING, DEBE SER MAYOR O IGUAL A 1")
Else
'Definimos cuantas columnas debemos verificar contando las que tienen contenido
fin = Application.CountA(Worksheets("Hoja1").Range("2:2"))
For i = 2 To fin
'Definimos el rango de cada columnas, desde la celda 1 hasta el final con datos
Range(Cells(2, i), Cells("65536", i)).Select
'Controlamos error si la versión de excel es 2003 o inferior
On Error GoTo Control_e
'Limpiamos cualquier formato anterior
With Selection.FormatConditions.Delete
End With
'Seleccionamos las "N" facturaciones más elevadas por día y hora
With Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
'Aquí marcamos el ranking que tendrá el valor que asignemos en la hoja excel
.Rank = Worksheets("Hoja1").Range("K4").Value
End With
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
End With
Selection.FormatConditions(1).StopIfTrue = False
End With
Next
End If
Worksheets("Hoja1").Range("B1").Select
On Error GoTo 0
Exit Sub
Control_e:
MsgBox ("SE REQUIERE UNA VERSIÓN DE EXCEL 2007 O SUPERIOR")
Exit Sub
Application.ScreenUpdating = True
End Sub

En esta macro recorremos todas las columnas y marcamos los 4 valores más altos en cada una de ellas. Los valores se pueden determinar en la propia macro o bien haciendo referencia a una celda en la hoja. En este caso, he optado por hacer la referencia en la hoja:

.Rank = Worksheets("Hoja1").Range("K4").Value

Por otra parte, también he introducido un control de error, (Control_e)  para que no ejecute el código y salga del proceso si la versión de Excel es 2003 o inferior.

Para realizar el mismo proceso, pero con los 4 valores inferiores, debemos modificar el código y ejecutar la siguiente macro:

Sub BottomX()
'----------------------------------------------------------------------------
'MARCAR LAS X PRIMERAS CIFRAS
'----------------------------------------------------------------------------
Dim i As Double
Application.ScreenUpdating = False
'Antes de comenzar debemos determinar el ranking que vamos a asignar,
'en este caso establecemos el valor en las "N" menores cifras.
If Worksheets("Hoja1").Range("K9").Value < "1" Then
MsgBox ("INDICA UN NUMERO DE VALORES QUE DETERMINEN EL RANKING, DEBE SER MAYOR O IGUAL A 1")
Else
'Definimos cuantas columnas debemos verificar contando las que tienen contenido
fin = Application.CountA(Worksheets("Hoja1").Range("2:2"))
For i = 2 To fin
'Definimos el rango de cada columnas, desde la celda 1 hasta el final con datos
Range(Cells(2, i), Cells("65536", i)).Select
On Error GoTo Control_e
'Limpiamos cualquier formato anterior
With Selection.FormatConditions.Delete
End With
'Seleccionamos las "N" facturaciones menores por día y hora
With Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xl10Bottom
'Aquí marcamos el ranking que tendrá el valor que asignemos en la hoja excel
.Rank = Worksheets("Hoja1").Range("K9").Value
End With
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
End With
Selection.FormatConditions(1).StopIfTrue = False
End With
Next
End If
Worksheets("Hoja1").Range("B1").Select
On Error GoTo 0
Exit Sub
Control_e:
MsgBox ("SE REQUIERE UNA VERSIÓN DE EXCEL 2007 O SUPERIOR")
Exit Sub
Application.ScreenUpdating = True
End Sub

Para hacer un ejemplo más funcional, he construido una especie de consola en la hoja para ejecutar ambas macros y además poder incluir manualmente los valores que queremos que establezcan el ranking, en este caso es 4:

Solo debéis introducir el número de valores a resaltar y pulsar en los botones de valores inferiores o superiores.

Dado que una vez que se ejecuta la macro, quedan los formatos condicionales grabados, para eliminarlos, debéis ejecutar la macro relacionada al botón «Restaurar Formatos», esa macro es:

Sub Restaura()
Application.ScreenUpdating = False
Worksheets("Hoja1").Range("B1").CurrentRegion.Select
With Selection.FormatConditions.Delete
Worksheets("Hoja1").Range("B1").Select
End With
Application.ScreenUpdating = True
End Sub

El resultado de aplicar ambas macros es el siguiente, los 4 valores más altas los marcamos en azul y los 4 más bajos en rojo, así:

Sin duda es una manera muy visual de establecer y comprobar aquellas horas del día en los que la facturación es más elevada o más baja.

Ahora os dejo el ejercicio completo para que practiquéis y podáis examinar el código, espero que os sea de utilidad  🙂

Descarga el archivo de ejemplo pulsando en: RESALTAR VALORES SUPERIORES E INFERIORES