VBA: Una función personalizada para construir un Balance de Situación.

Hoy veremos una UDF (función personalizada en VBA) muy sencilla como respuesta a la cuestión planteada de un usuario, quien solicitaba una fórmula para construir fácilmente un Balance de Situación a partir de un Suma y Saldos (o balance de comprobación).

Para los no entendidos resumiré la idea. Vamos a generar una UDF (función personalizada con VBA) para poder sumar en un informe un determinado número de cuentas, tomadas del balance de sumas y saldos, agrupadas por epígrafes y dividido en distintas masas patrimoniales.
Partiremos del siguiente Balance de sumas y saldos ficticio, para construir un Balance de Situación 'abreviado'... sirva como ejemplo:

haz clic en la imagen

Observamos en el rango A1:B23 una Tabla con el balance de sumas y saldos...
y cómo tenemos construido un Balance de Situación en el rango E2:G20.
Lo importante aparece en la columna D donde hemos desplegado las cuentas asociadas a cada epígrafe de nuestro Balance inventado.

Para resolver nuestra cuestión en particular, insertamos el siguiente código dentro de un módulo estándar del explorador de proyectos del Editor de VB:

Function SumaBlce(ByVal Buscados As String, RngCuentas As Range, Saldos As Range)
'www.excelforo.com

'primer argumento: indicamos qué cuentas queremos acumular
'segundo argumento: en qué rango se encuentran las cuentas con que comparar
'tercer argumento: en qué rango se sitúan los importes coincidentes a sumar.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'con la Array Cuentas determinamos qué cuentas queremos acumular...
'generadas a aprtir de lo indicado en el primer argumento de nuestra función
Dim Cuentas() As String: Cuentas = Split(Buscados, ",")
'definimos el número de cuentas a sumar
Dim NumCuentas As Integer: NumCuentas = UBound(Cuentas)

Dim fila As Integer, filas As Integer
Dim Elto As Integer, coincidente As Boolean

'partimos de un Resultado igual a 0
Dim Resultado As Double: Resultado = 0
'controlamos que la longitud del rango en Cuentas y Saldos sea el mismo
If (RngCuentas.Count <> Saldos.Count) Or (RngCuentas.Columns.Count <> 1 Or Saldos.Columns.Count <> 1) Then
    SumaBlce = "error en rangos"
    Exit Function
End If

'recorremos toda las Cuentas del RngCuentas
x = 1
For Each cta In RngCuentas
    coincidente = False
    For Elto = 0 To NumCuentas
        If cta.Value = Cuentas(Elto) Then
            coincidente = True
            Exit For
        End If
    Next Elto
    'si existe la cuenta entonces acumulamos...
    If coincidente = True Then
        Resultado = Resultado + CDbl(Saldos.Item(x))
    End If
    x = x + 1
Next cta

'devolvemos el resultado final a la celda.
SumaBlce = Resultado

End Function

Como podemos comprobar en la imagen de más arriba, por ejemplo en la celda G4, nuestra fórmula se compone de tres argumentos:
=SumaBlce(D4;TblDatos[Cuenta];TblDatos[Importe])

1er argumento: indicamos qué cuentas queremos acumular. En este caso tomamos la lista de cuentas de la celda D4
2do argumento: en qué rango se encuentran las cuentas con que comparar. En el ejemplo trabajamos sobre el campo [Cuenta] de la Tabla 'TblDatos
3er argumento: en qué rango se sitúan los importes coincidentes a sumar. En el ejemplo trabajamos sobre el campo [Importe] de la Tabla 'TblDatos.