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 *