Máximos no repetidos con Excel

Descripción del problema

La función =MAX(Rango) de Excel nos devuelve el valor máximo del rango de celdas que se le suministra como argumento entre paréntesis.

La función =K.ESIMO.MAYOR (Rango, Orden) nos devuelve el máximo del orden dado en es mismo rango, es decir, si el orden es 1, el máximo será el mismo que nos devuelve MAX, si es 2 será el segundo valor más grande, etc.

Pero si el máximo está repetido en más de una celda del rango, por ejemplo, imaginemos que en el rango A1:A6 tenemos los valores:

10, 5, 6, 10, 3, 7

Nos encontramos la sorpresa de que la función K.ESIMO de orden 2 no nos devuelve el segundo valor más grande de la lista, que sería el 7, sino que la expresión:

=K.ESIMO.MAYOR (A1:A6, 2)

Nos devuelve también 10.

Las funciones MAX, y K.ESIMO, tanto en su variedad MAYOR como MENOR, no distinguen los valores repetidos, y esto puede ser una clara limitación en ciertos casos en los que necesitemos saber realmente cual es el segundo valor, o en general el enésimo valor más grande de una lista, independientemente de cuantas veces está repetido, ese enésimo o el n-1 o el que sea.

Soluciones al problema

Si nos quedamos en la biblioteca de funciones nativas de Excel, no tendríamos más remedio que anidar algunas condiciones dentro de estas funciones y recurrir a construcciones matriciales para devolver el resultado.

Pero las construcciones matriciales son para mí el último recurso y antes de llegar a ellas, prefiero zambullirme en el entorno de programación y crear con VBA una función que haga precisamente lo que necesitamos, o sea:

que analice un rango que se le suministra como argumento

que cree una lista de valores únicos a partir de la original

que ordene esa lista con criterio ascendente

que nos devuelva el valor de la lista con el número de orden dado también como argumento

Esta es la función =MAYORDEORDEN($A$1:$A$6;2), que así escrita para el caso que venimos analizando, nos devolvería el valor 7

Aquí os dejo el código, el enlace para que os descarguéis el archivo: Máximos no repetidos con Excel y abajo del todo está el video explicativo.

Código a insertar en módulo VBA

Option Explicit

Function MAYORDEORDEN(queRango As Range, nOrden As Long)

‘Recorremos el rango y creamos una lista de valores únicos

Dim cell As Object, queConjunto(), nTotal As Long, nUnicos As Long, I As Long

nTotal = queRango.Cells.Count

ReDim queConjunto(1 To nTotal)

I = 0

‘Cargamos valores del rango en el vector queConjunto

For Each cell In queRango.Cells

I = I + 1

queConjunto(I) = cell.Value

Next cell

‘Ordenamos ese vector de mayor a menor

Call NumSort(queConjunto, False)

‘Calculamos el número de elementos únicos en ese vector

Dim queUnicos() As Variant

ReDim queUnicos(1 To 1)

‘Inicializamos el primer elemento

nUnicos = 1

queUnicos(1) = queConjunto(1)

‘Recorremos el bucle quedándonos con valores únicos

For I = 2 To nTotal

If queConjunto(I) = queConjunto(I – 1) Then

‘Nada

Else

nUnicos = nUnicos + 1

ReDim Preserve queUnicos(1 To nUnicos)

queUnicos(nUnicos) = queConjunto(I)

End If

Next I

‘Al salir de este bucle el vector queUnicos tiene la lista de valores únicos que ademas están ordenados

‘Por si acaso, los reordenamos

Call NumSort(queUnicos, False)

‘Y ahora simplemente saquemos el mayor del orden indicado en el argumento de arriba

MAYORDEORDEN = queUnicos(nOrden)

End Function

Sub NumSort(nums() As Variant, Ascending As Boolean)

‘Subrutina de ordenación numérica, copiada del libro de John Walkenbach

‘Pass in numeric array you want to sort by reference and read it back. The array should be declared as an array

‘of variants

‘Set Ascending to True to sort ascending,false to sort descending

Dim I As Integer

Dim J As Integer

Dim NumInArray, LowerBound As Integer

NumInArray = UBound(nums)

LowerBound = LBound(nums)

For I = LowerBound To NumInArray

J = 0

For J = LowerBound To NumInArray

If Ascending = True Then

If nums(I) < nums(J) Then

NumSwap nums(I), nums(J)

End If

Else

If nums(I) > nums(J) Then

NumSwap nums(I), nums(J)

End If

End If

Next J

Next I

End Sub

Private Sub NumSwap(var1 As Variant, var2 As Variant)

Dim x As Variant

x = var1

var1 = var2

var2 = x

End Sub