MaxArrSiConjunto

Esta función nos permite obtener el valor máximo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor máximo del rango. La particularidad de esta función es que te permite acceder al valor máximo (primer máximo, segundo máximo, tercer máximo)

=MaxArrSiConjunto([1];[2];[3′];[4′];[3”];[4”]…..)

[1]: Rango de valores que queremos encontrar el valor máximo

[2]: Posición del array (1: pirmer máximo, 2: segundo máximo….)

[3′]: Rango que tienen las condiciones

[4′]: Condición

[3”]: Segundo Rango que tienen las condiciones

[4”]: Segunda Condición

…… Tantos rangos y condiciones como quieras

Public Function MaxArrSiConjunto(Unico As Range, Pos As Integer, ParamArray prms() As Variant) As Variant
    '=MaxSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos contar sin repetidos
       '[2]: Posición del array (1: pirmer máximo, 2: segundo máximo....)
       '[3']: Rango que tienen las condiciones
       '[4']: Condición
       '[5'']: Segundo Rango que tienen las condiciones
       '[6'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim i As Integer
 
    Dim col As New Collection
    Dim colSort As New Collection
    Dim varElement As Variant
 
    filaInit = Unico.Row
    filaFinal = filaInit + Unico.Count - 1
 
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    If (x = Int(x)) Then
        On Error Resume Next
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If (Condicion) Then
                col.Add Item:=CStr(CLng(Unico(i))), Key:=CStr(CLng(Unico(i)))
            End If
        Next i
 
        Set colSort = fnVarBubbleSort(col, False)
 
        i = 1
        MaxArrSiConjunto = "#NoValue"
        For Each varElement In colSort
            If i = Pos Then
                'Debug.Print varElement
                MaxArrSiConjunto = CLng(varElement)
            End If
            i = i + 1
        Next varElement
    Else
       MaxArrSiConjunto = "#ERROR"
    End If
End Function
 
Public Function fnVarBubbleSort(ByRef colInput As Collection, Optional bAsc = True) As Collection
 
    Dim varTemp                 As Variant
    Dim lngCounter              As Long
    Dim lngCounter2             As Long
 
    For lngCounter = 1 To colInput.Count - 1
        For lngCounter2 = lngCounter + 1 To colInput.Count
            Select Case bAsc
            Case True:
                If colInput(lngCounter) > colInput(lngCounter2) Then
                    varTemp = colInput(lngCounter2)
                    colInput.Remove lngCounter2
                    colInput.Add varTemp, varTemp, lngCounter
                End If
 
            Case False:
                If colInput(lngCounter) < colInput(lngCounter2) Then
                    varTemp = colInput(lngCounter2)
                    colInput.Remove lngCounter2
                    colInput.Add varTemp, varTemp, lngCounter
                End If
            End Select
        Next lngCounter2
    Next lngCounter
 
    Set fnVarBubbleSort = colInput
 
End Function

MaxSiConjunto

Esta función nos permite obtener el valor máximo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor máximo del rango.

=MaxSiConjunto([1];[2′];[3′];[2”];[3”]…..)

[1]: Rango de valores que queremos encontrar el valor máximo/p>

[2′]: Rango que tienen las condiciones

[3′]: Condición

[2”]: Segundo Rango que tienen las condiciones

[3”]: Segunda Condición ‘…… Tantos rangos y condiciones como quieras

Public Function MaxSiConjunto(ValMax As Range, ParamArray prms() As Variant) As Variant
 
    '=MaxSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos encontrar el valor máximo
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
 
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim MAX As Variant
 
 
    filaInit = ValMax.Row
    filaFinal = filaInit + ValMax.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    MAX = "#ERROR"
    If (x = Int(x)) Then
        On Error Resume Next
        MAX = "#ERROR"
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If Condicion Then
                If (CLng(ValMax(i)) > CLng(MAX)) Then
                    MAX = CLng(ValMax(i))
                End If
            End If
        Next i
    End If
    MaxSiConjunto = MAX
End Function

MinSiConjunto

Esta función nos permite obtener el valor mínimo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor mínimo del rango.

=MinSiConjunto([1];[2′];[3′];[2”];[3”]…..)

[1]: Rango de valores que queremos encontrar el valor mínimo

[2′]: Rango que tienen las condiciones

[3′]: Condición

[2”]: Segundo Rango que tienen las condiciones

[3”]: Segunda Condición ‘…… Tantos rangos y condiciones como quieras

Public Function MinSiConjunto(ValMin As Range, ParamArray prms() As Variant) As Variant
    '=MinSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos encontrar el valor minimo
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
 
 
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim MIN As Variant
 
 
    filaInit = ValMin.Row
    filaFinal = filaInit + ValMin.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    MIN = "#ERROR"
    If (x = Int(x)) Then
        On Error Resume Next
        MIN = "#ERROR"
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If Condicion Then
                If (CLng(ValMin(i)) < CLng(MIN)) Then
                    MIN = CLng(ValMin(i))
                End If
            End If
        Next i
    End If
    MinSiConjunto = MIN
End Function