VBA: Función Filter sobre Arrays

Hoy un poco de VBA para Excel.
Hablaré de la función de VBA Filter(sourcearray, match, [ include, [ compare ]])
función que nos devuelve una matriz con aquellos elementos que cumplan las condiciones de coincidencia impuestas.
Los cuatro argumentos de la función a completar:
- sourcearray (obligatorio): Debe ser una matriz unidimensional de cadenas en la que se va a realizar la búsqueda.
- coincidencia (obligatorio): Qué buscamos.
- include (opcional): El valor Boolean que indica si se devuelven subcadenas que incluyan o excluyan la coincidencia.
Si incluir tiene el valor True, la función Filter devuelve el subconjunto de la matriz que contiene la coincidencia como una subcadena.
Si incluir tiene el valor False, Filter devuelve el subconjunto de la matriz que no contiene la coincidencia como una subcadena.
- compare (opcional): Valor numérico que indica el tipo de comparación de cadena que se va a usar.
Valores posibles de este argumento:
* vbUseCompareOption (ó -1): Realiza una comparación usando la configuración de la instrucción Option Compare.
* vbBinaryCompare (ó 0): Lleva a cabo una comparación binaria.
* vbTextCompare (ó 1): Lleva a cabo una comparación textual.

En definitiva la función filter aplicada sobre una matriz unidimensional devuelve una nueva matriz con el listado de coincidencias...

Veamos un uso diferente para esta función.
Tenemos un listado de países con ciertos importes asociados, y por otra parte otro listado de paises de los cuales queremos obtener su acumulado.

Así pues accederemos al editor de VB y en un módulo estándar insertaremos el siguiente código de nuestra función personalizada:

Function fxACUM(rngBuscados As Range, rngListado As Range, colSuma As Long)
'identificamos la matriz con los elementos buscados
Dim arrBuscados As Variant
arrBuscados = Application.Transpose(rngBuscados)

'y la matriz donde buscar
Dim arrListado As Variant
arrListado = Application.Transpose(rngListado)

'control num columna
If colSuma > UBound(arrListado) Then
    fxACUM = "num_col_superada"
    Exit Function
End If

'Dim arrPosicion() As Variant
Dim arrImporte() As Variant

i = 0
For elto = LBound(arrListado, 2) To UBound(arrListado, 2)
    Dim existe As Variant
    'función filter que devuelve una nueva matriz con los elementos que cumplan
    existe = Filter(arrBuscados, arrListado(1, elto), , vbTextCompare)
    
    'si tiene algún elemento
    If UBound(existe) >= 0 Then
        i = i + 1
        ReDim Preserve arrImporte(1 To i) As Variant
        'cargamos una matriz con los importes a acumular
        arrImporte(i) = arrListado(colSuma, elto)
    End If
Next elto

'retornamos la suma de la matriz...
fxACUM = Application.Sum(arrImporte)
End Function

Y como veíamos en la imagen anterior nos devuelve el resultado correcto de importes acumulados de los distintos paises elegidos.

El punto clave del procedimiento descrito es cuando se define una matriz 'existe' que cargamos con la matriz resultante de aplicar la función Filter sobre la matriz unidimensional de países buscados, y donde como elemento buscado damos cada uno de los paises, mediante el bucle For...Next, de la primera columna del rango de pais+importe.
Esto cargará con elementos siempre que haya coincidencia... en cuyo caso la función Ubound nos devolverá un valor distinto de cero... lo que aprovechamos con el condicional descrito para cargar ese dato en una matriz para los importes..
Matriz que será la que acabaremos sumando :O