Office y Programación: Edad Bruta y Edad Neta. Microsoft Excel y VBA

Edad Bruta y Edad Neta

Solución en Excel

Aplicando una secuencia de funciones anidadas, podemos llegar al resultado correcto.

Edad Bruta:               =AÑO(HOY())-AÑO(A4)

Edad Neta:

=SI(AÑO(HOY())>AÑO(A5);SI(MES(HOY())>MES(A5);AÑO(HOY())-AÑO(A5);SI(MES(HOY())<MES(A5);AÑO(HOY())-AÑO(A5)-1;SI(DIA(HOY())>=DIA(A5);AÑO(HOY())-AÑO(A5);AÑO(HOY())-AÑO(A5)-1)));0)

Solución en VBA

Código VBA que resuelve el mismo problema. El botón <Calcular Edades> está asociado a la macro <Calcular_Edades> que a su vez invoca a los procedimientos

< Calcular_Edad_Bruta> y < Calcular_Edad_Neta>.

Nótese que se han aplicado dos soluciones diferentes:

a)    La que calcula las edades y coloca el resultado en la celda correspondiente;

b)    La que coloca en la celda correspondiente la fórmula adecuada para que sea el propio Excel quien resuelva el cálculo.

Option Explicit

Sub Calcular_Edad_Bruta()

   Dim oWorksheet As Worksheet

   Dim dFechaNacimiento As Date

   Set oWorksheet = ThisWorkbook.Worksheets(1)

   dFechaNacimiento = oWorksheet.Cells(13, 1)

   oWorksheet.Cells(13, 3) = Year(Now()) – Year(dFechaNacimiento)

   dFechaNacimiento = oWorksheet.Cells(14, 1)

   oWorksheet.Cells(14, 3) = Year(Now()) – Year(dFechaNacimiento)

End Sub

 

Sub Calcular_Edad_Neta()

   Dim oWorksheet As Worksheet

   Dim dFechaNacimiento As Date

   Set oWorksheet = ThisWorkbook.Worksheets(1)

   dFechaNacimiento = oWorksheet.Cells(13, 1)

   oWorksheet.Cells(13, 5) = F_Edad_Neta(dFechaNacimiento)

   dFechaNacimiento = oWorksheet.Cells(14, 1)

   oWorksheet.Cells(14, 5) = F_Edad_Neta(dFechaNacimiento)

End Sub

 

Function F_Edad_Neta(ByVal pFecha As Date) As Integer

   If Year(Now()) > Year(pFecha) Then

      If Month(Now()) > Month(pFecha) Then

         F_Edad_Neta = Year(Now()) – Year(pFecha)

      Else

         If Month(Now()) < Month(pFecha) Then

            F_Edad_Neta = Year(Now()) – Year(pFecha) – 1

         Else

            If Day(Now()) >= Day(pFecha) Then

               F_Edad_Neta = Year(Now()) – Year(pFecha)

            Else

               F_Edad_Neta = Year(Now()) – Year(pFecha) – 1

            End If

         End If

      End If

   Else

      F_Edad_Neta = 0

   End If

End Function

Sub Calcular_Edades()

   Call Calcular_Edad_Bruta

   Call Calcular_Edad_Neta

End Sub

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *