Máximos colaboradores

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

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