|
Hola:
Te he desarrollado una función que tendrás que copiarla en un módulo del Editor (Alt+F11, Insertar módulo)
Coloqué 2 formas de escribir cada nombre (mayúsc JOSE y minúsc.con acento José). Si estilan escribir también las mayúsc con acento o todo en minúsculas, habrá que incluirlas en la instrucción correspondiente.
Esta función tiene 2 argumentos: dato y fecha. En la celda que quieras obtener este código, escribi:
=contribuye(B2;C2) considero que en B están los nombres y en C las fechas. Luego la arrastrás al resto de la col.
Si te da error en el nombre de la función, presioná el botón Funcion y buscá las definidas por el usuario. Ahí estará.
Function contribuye(dato As String, fecha As String)
Dim ini As Integer, conta As Integer
Dim letra1 As String, letra2 As String, letrax As String, letra3 As String
Dim espa1 As Integer, espa2 As Integer, espa3 As Integer
Dim texto As String
Dim año As String, mes As String, dia As String
ini = 2
conta = 0
letra1 = Mid(dato, 1, 1)
letrax = Mid(dato, 2, 1)
While conta = 0
If letrax <> "A" And letrax <> "E" And letrax <> "I" And letrax <> "O" And letrax <> "U" Then
ini = ini + 1
letrax = Mid(dato, ini, 1)
Else
conta = 1
End If
Wend
letra2 = letrax
espa1 = Application.WorksheetFunction.Search(" ", dato, 1)
letra3 = Mid(dato, espa1 + 1, 1)
espa2 = Application.WorksheetFunction.Search(" ", dato, espa1 + 1)
On Error Resume Next
espa3 = Application.WorksheetFunction.Search(" ", dato, espa2 + 1)
texto = Mid(dato, espa2 + 1, espa3 - espa2 - 1)
If texto = "JOSE" Or texto = "MARIA" Or texto = "José" Or texto = "María" Then
letra4 = Mid(dato, espa3 + 1, 1)
Else
letra4 = Mid(dato, espa2 + 1, 1)
End If
año = Mid(fecha, 3, 2)
mes = Mid(fecha, 5, 2)
dia = Mid(fecha, 7, 2)
contribuye = letra1 & letra2 & letra3 & letra4 & año & mes & dia
End Function
Espero tus comentarios y/o la finalización de la consulta.
Saludos cordiales,
Elsa
|
