Macro para definir cumpleaños.

[pinoji]

Buenas noches colegas. Espero se encuentren bien todos.

Tengo un pequeño problema;

A partir del numero de identidad (para otros países creo que es RUP) yo extraigo la fecha de nacimiento, y calculo la edad de cada trabajador, pero me da un "desfase" con fechas que comienzan a partir del 2000.

=FECHA(VALOR(EXTRAE([@[C. Identidad]];1;2));VALOR(EXTRAE([@[C. Identidad]];3;2));VALOR(EXTRAE([C. Identidad];5;2)))

Fecha para hallar la edad

=AÑO($A$2)-AÑO([@[FECHA NAC.]])

Pueden ayudarme a definir o corregir este problema?

Y si no fuera mucho pedir, me gustaría hacer esto desde VBA y evitar fórmulas o funciones en la hoja de cálculo.

Gracias de antemano.

Saludos

Pino

Cumpleaños Foro.xlsm

[Antoni]

Te dejo una función, puedes usarla en macros y formularios o como fórmula.

Function Edad(Identidad As String) As Variant
Dim Año, Mes, Día
'--
If Not IsNumeric(Identidad) Or Not Len(Identidad) = 11 Then
   Edad = "#Error Identidad"
   Exit Function
End If
'--
Año = CInt(Left(Identidad, 2))
If Año > Year(Date) - 2000 Then
   Año = Año + 1900
Else
   Año = Año + 2000
End If
'--
Mes = CInt(Mid(Identidad, 3, 2))
Día = CInt(Mid(Identidad, 5, 2))
Edad = Year(Date) - Año
'--
If Mes > Month(Date) Or _
   (Mes = Month(Date) And Día > Day(Date)) Then
   Edad = Edad - 1
   Exit Function
End If
End Function

 

Cumpleaños Foro.xlsm

[JSDJSD]

Hola a ambos, te dejo otra posible solución

[JSDJSD]

Private Sub CommandButton1_Click()
    With Hoja8
        ultimaFila = .Cells(.Rows.Count, "B").End(xlUp).Row
        
        For Each celda In .Range("B5:B" & ultimaFila)
            If Not IsEmpty(celda.Value) Then
                año = CInt(Mid(celda.Value, 1, 2))
                mes = CInt(Mid(celda.Value, 3, 2))
                día = CInt(Mid(celda.Value, 5, 2))

                If año <= 21 Then
                    año = año + 2000
                Else
                    año = año + 1900
                End If

                On Error Resume Next
                fechaResultado = DateSerial(año, mes, día)
                If Err.Number <> 0 Then
                    fechaResultado = "Fecha Inválida"
                    Err.Clear
                End If
                On Error GoTo 0

                celda.Offset(0, 1).Value = fechaResultado
            End If
        Next celda

        If IsDate(.Range("A2").Value) Then
            fechaReferencia = .Range("A2").Value
        Else
            MsgBox "La celda A2 no contiene una fecha válida.", vbExclamation
            Exit Sub
        End If

        For i = 5 To ultimaFila
            If IsDate(.Cells(i, "C").Value) Then
                .Cells(i, "K").Value = Year(fechaReferencia) - Year(.Cells(i, "C").Value)
            Else
                .Cells(i, "K").Value = "Fecha no válida"
            End If
        Next i
    End With
End Sub

 

Cumpleaños Foro.xlsm

[pinoji]

Buenas tardes colegas del Foro. Buenas tardes Profesor Antoni y Porfesor JSD. Una vez más en "encrucijada" positiva, es una suerte tener dos soluciones de dos personas a las que admiro. Gracias a ambos.

Las dos son perfectas (como siempre), nada que acotar, solo agradecer otra vez más a los dos por sus aportes y desearle mucha salud y bendiciones.

Gracias y mis respetos.

saludos

Pino.