VBA: Descomponer Nombres y Apellidos compuestos

Muchas veces en las formaciones que imparto me preguntan por la manera de conseguir obtener, a partir de un Nombre completo escrito en una celda, por separado, Nombre y Apellidos...
El problema es siempre el mismo: Los Nombres y Apellidos compuestos

Por suerte existen una serie limitada de combinaciones de palabras que se emplean en los nombres y apellidos compuestos (ordenados en sentido ascendente):
"de", "del", "el", "la", "las", "los", "san", "y"

Estas palabras son muy importantes, ya que nos permitirán identificar los inicios de nuestros apellidos o nombres compuestos.

He generado una función personalizada con VBA, empleando matrices (Arrays) que a partir de un Nombre completo (nombre y dos apellidos) compuesto o no, nos devuelve las tres partes de manera individual, cada una en una celda... ejecutando nuestra UDF matricialmente.

haz clic en la imagen

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 NombreApellidos(NombreCompuesto As String)
Dim aApellido() As String, N_Apellido As String

'separamos las partes de los apellidos
aApellido = Split(NombreCompuesto, " ")

'recorremos cada palabra...
For elto = 0 To UBound(aApellido)
    'homogeneizamos todo en minúscula
    Select Case LCase(aApellido(elto))
        Case "de", "del", "el", "la", "las", "los", "san", "y"
            N_Apellido = N_Apellido & aApellido(elto) & " "
        Case Else
            'si es la última parte del apellido
            If elto = UBound(aApellido) Then
                'no añadimos ningún separador al final.
                N_Apellido = N_Apellido & aApellido(elto)
            Else
                'en caso contrario añadimos una barra vertical |
                N_Apellido = N_Apellido & aApellido(elto) & "|"
        End If
    End Select
Next elto

'contamos partes del nombre
Dim nNombreCompleto() As String
Dim NombreFinal() As String
Dim partes As Integer, Apellido As String

'Obtenemos una matriz con las partes descompuestas
nNombreCompleto = Split(N_Apellido, "|")
'conteo de las partes del Nombre y Apellidos descompuesto
'debe ser mínimo 3 partes := Nombre + Apellido1 + Apellido2
'pero podría devolvernos 4 partes o más en caso de Nombre compuesto!
partes = UBound(nNombreCompleto) + 1

'Recomponemos Nombre y Apellidos
ReDim NombreFinal(0 To partes) As String
If partes > 3 Then  'esto nos indica que el Nombre es Compuesto!
    'Juntamos las dos primeras partes como un único elemento
    NombreFinal(0) = nNombreCompleto(0) & " " & nNombreCompleto(1)
    contador = 1
    'el resto los cargamos tal cual...
    For x = 2 To UBound(nNombreCompleto)
        NombreFinal(contador) = nNombreCompleto(x)
        contador = contador + 1
    Next x
Else    'si el Nombre NO es compuesto
    'cargamos uno a uno las partes del nombre
    For x = 0 To UBound(nNombreCompleto)
        NombreFinal(contador) = nNombreCompleto(x)
        contador = contador + 1
    Next x
End If
'devolvemos el nombre completo a la funcion
'OJO!! EJECUTARLA MATRICIALMENTE PARA OBTENER EN CADA CELDA EL DATO CORRESPONDIENTE!!
NombreApellidos = NombreFinal
End Function

El resultado se puede ver en la imagen anterior... ejecutando nuestra función matricialmente, conseguimos nuestro objetivo...