jueves, 9 de enero de 2014

VBA: Una función personalizada de fórmula 3D.

Un par de años atrás escribí una entrada en el blog explicando algo más sobre las fórmulas tridimensionales (fórmulas 3D) en Excel (ver).
En particular, era interesante conocer las limitaciones en cuanto a operaciones a realizar sobre diferentes hojas: SUMA, PROMEDIO, PROMEDIOA, CONTARA, MAXA,MIN, MINA, PRODUCTO, DESVEST, DESVESTA, DESVESTP, DESVESTPA, VAR, VARA, VARP y VARPA.

La cuestión entonces es ¿qué ocurre si pretendo realizar una suma condicionada sobre varias hojas de un mismo libro?. La respuesta es clara, tendremos que crear nuestra UDF o función VBA personalizada.

Planteemos un ejemplo sencillo. Queremos sumar el valor de la celda A1 de diferentes hojas sólo cuando este valor sea mayor que 2014.
Tenemos un Libro con 5 hojas con datos en la celda A1 (valdría valores en un rango de celdas...):

VBA: Una función personalizada de fórmula 3D.


Y en una última hoja 'Total' queremos 'consolidar' los datos, pero sólo los mayores a 2014.
Es decir, sabemos que debemos consolidar las Hojas 1 a 5, que están seguidas/consecutivas en orden de disposición.

Añadiremos nuestro código asociándolo a un Módulo; para ello accederemos a la ventana de código del explorador del editor de VBA, donde insertaremos el siguiente código VBA:

Function Suma3Dmayor2014(celdas As Range) As Variant
Dim primerahoja As String, ultimahoja As String
'definimos cuáles son nuestras hojas límites...
    primerahoja = Hoja1.Name
    ultimahoja = Hoja5.Name

Dim HjInicio As Long, HjFin As Long
Dim HjActual As Long
Dim Addr As String
Dim rng As Range
Dim SumaAcum As Double
Dim SheetDataRange As Range

Application.Volatile

With ThisWorkbook.Worksheets
    ' Si se produce un error, construir el mensaje de error
    ' Inicializa el controlador de error.

    On Error Resume Next
    Err.Clear
    
    'controlamos el tipo posible de error
    'si no existiera la Hoja1
    HjInicio = .Item(primerahoja).Index
    If Err.Number <> 0 Then
        Suma3Dmayor2014 = CVErr(xlErrRef)
        Exit Function
    End If
    'si no existiera la Hoja5
    HjFin = .Item(ultimahoja).Index
    If Err.Number <> 0 Then
        Suma3Dmayor2014 = CVErr(xlErrRef)
        Exit Function
    End If
    'si por alguna causa la Hoja Inicial (Hoja1) no está situada a la izquierda de la Hoja final (Hoja5)
    If HjInicio > HjFin Then
        Suma3Dmayor2014 = CVErr(xlErrRef)
        Exit Function
    End If
    'si no hemos identificado qué celda/s sumar en nuestra función
    If celdas Is Nothing Then
        Suma3Dmayor2014 = CVErr(xlErrRef)
        Exit Function
    End If
    
    ' Addr es la dirección del rango indicado en nuestra función UDF para sumar.
    Addr = celdas.Address
    'recorremos las diferentes hojas desde la Hoja1 a la Hoja5
    For HjActual = HjInicio To HjFin
        'Usamos Addr para construir un rango de valores.
        Set SheetDataRange = .Item(HjActual).Range(Addr)
        'recorremos el rango de celdas por las hojas de estudio
        For Each rng In SheetDataRange.Cells
            If Len(rng.Value) > 0 Then
                    If rng.Value > 2014 Then
                        'acumulamos los valores que cumplan nuestra condición >2014
                        SumaAcum = SumaAcum + rng.Value
                    End If
            End If
        Next rng
    Next HjActual
End With

'Suma final llevada a la Hoja de cálculo.
Suma3Dmayor2014 = SumaAcum
End Function



Listos para probarla, en alguna celda de la hoja de cálculo, por ejemplo en la celda C1 de la hoja Total escribimos:
=Suma3Dmayor2014(A1)
el resultado será de 4.031 (es decir, 0+0+0+2015+2016 0 4.031), esto es, sólo ha sumado los importes de las diferentes hojas, en la celda informada en nuestra función A1, que cumplen la condición definida (valores mayores a 2014).

No hay comentarios:

Publicar un comentario en la entrada