Jump to content

Cómo restar dos fechas si alguna es anterior al año 1900


Recommended Posts

@zelarra821, cuando abras un tema acostúmbrate a incluir una plantilla de ejemplo con los datos de partida y el resultado esperado, para no irnos por las ramas o por la tangente al contestar. De todos modos, esta vez te lo perdono pues este tema es continuación de uno anterior:

Ahora mismo preparo una respuesta... Estate atento...

Link to post
Share on other sites

He preparado y probado un par de funciones:

  1. RestarFechas con la diferencia en días entre dos fechas.
  2. ObtenerEdad con la diferencia en años entre dos fechas.

La segunda es la que te dará el resultado esperado como puedes ver en este ejemplo:

image.png.e76c0332290266403dc57b65e01e25ab.png

Este es el código de las dos funciones sugeridas:

Option Explicit

Function ObtenerEdad(sFecha1 As String, sFecha2 As String) As Long
'
' Obtiene la diferencia en años entre dos fechas en formato Long
' Argumentos: sFecha1 y sFecha2 con las fechas a restar en formato String
' Rango de fechas desde el 1 de enero de 100 hasta el 31 de diciembre de 9999.
'
' Funciones VBA: DateValue y DateDiff("yyyy",date1,date2) Functions
'
    Dim dtFecha1 As Date
    Dim dtFecha2 As Date
   
    dtFecha1 = DateValue(sFecha1)
    dtFecha2 = DateValue(sFecha2)

    ObtenerEdad = DateDiff("yyyy", dtFecha1, dtFecha2)
    
End Function

Function RestarFechas(sFecha1 As String, sFecha2 As String) As Long
'
' Obtiene la diferencia entre dos fechas en formato Long
' Argumentos: sFecha1 y sFecha2 con las fechas a restar en formato String
' Rango de fechas desde el 1 de enero de 100 hasta el 31 de diciembre de 9999.
'
' Funciones VBA: DateValue y DateDiff("d",date1,date2) Functions
'
    Dim dtFecha1 As Date
    Dim dtFecha2 As Date
   
    dtFecha1 = DateValue(sFecha1)
    dtFecha2 = DateValue(sFecha2)

    RestarFechas = DateDiff("d", dtFecha1, dtFecha2)
    
End Function

Como puedes comprobar, la única diferencia es el primer argumento de la función DateDiff que, para la edad en años debe ser "yyyy" y para la diferencia en días es "d". Esta función es muy potente para obtener diferencias de fechas como se puede estudiar en el siguiente enlace: DateDiff function

Adjunto archivo de ejemplo en el que se deben habilitar las macros. Las nuevas funciones están en el módulo "ModRestarFechas".

Incluye como un plus una hoja con un ejemplo del tema anterior para calcular el día de la semana.

Años Menores que 1900 PW2.xlsm

Edited by pegones1
Link to post
Share on other sites

Muchas gracias. Es mucho más simple. Yo encontré una función por Internet, y añadió una mía para calcularlo, pero no sé los límites que tiene ni nada. Es esta:

' This is the initial function. It takes in a start date and an end date.
Public Function AgeFunc(stDate As Variant, endate As Variant)

    ' Dim our variables.
    Dim stvar As String
    Dim stmon As String
    Dim stday As String
    Dim styr As String
    Dim endvar As String
    Dim endmon As String
    Dim endday As String
    Dim endyr As String
    Dim stmonf As Integer
    Dim stdayf As Integer
    Dim styrf As Integer
    Dim endmonf As Integer
    Dim enddayf As Integer
    Dim endyrf As Integer
    Dim years As Integer

    ' This variable will be used to modify string length.
    Dim fx As Integer
    fx = 0

    ' Calls custom function sfunc which runs the Search worksheet function
    ' and returns the results.
    ' Searches for the first "/" sign in the start date.
    stvar = sfunc("/", stDate)

    ' Parse the month and day from the start date.
    stmon = Left(stDate, sfunc("/", stDate) - 1)
    stday = Mid(stDate, stvar + 1, sfunc("/", stDate, sfunc("/", stDate) + 1) - stvar - 1)

    ' Check the length of the day and month strings and modify the string
    ' length variable.
    If Len(stday) = 1 Then fx = fx + 1
    If Len(stmon) = 2 Then fx = fx + 1

    ' Parse the year, using information from the string length variable.
    styr = Right(stDate, Len(stDate) - (sfunc("/", stDate) + 1) - stvar + fx)

    ' Change the text values we obtained to integers for calculation
    ' purposes.
    stmonf = CInt(stmon)
    stdayf = CInt(stday)
    styrf = CInt(styr)

    ' Check for valid date entries.
    If stmonf < 1 Or stmonf > 12 Or stdayf < 1 Or stdayf > 31 Or styrf < 1 Then
        AgeFunc = "Invalid Date"
        Exit Function
    End If

    ' Reset the string length variable.
    fx = 0

    ' Parse the first "/" sign from the end date.
    endvar = sfunc("/", endate)

   ' Parse the month and day from the end date.
    endmon = Left(endate, sfunc("/", endate) - 1)
    endday = Mid(endate, endvar + 1, sfunc("/", endate, sfunc("/", endate) + 1) - endvar - 1)

    ' Check the length of the day and month strings and modify the string
    ' length variable.
    If Len(endday) = 1 Then fx = fx + 1
    If Len(endmon) = 2 Then fx = fx + 1

    ' Parse the year, using information from the string length variable.
    endyr = Right(endate, Len(endate) - (sfunc("/", endate) + 1) - endvar + fx)

    ' Change the text values we obtained to integers for calculation
    ' purposes.
    endmonf = CInt(endmon)
    enddayf = CInt(endday)
    endyrf = CInt(endyr)

    ' Check for valid date entries.
    If endmonf < 1 Or endmonf > 12 Or enddayf < 1 Or enddayf > 31 Or endyrf < 1 Then
        AgeFunc = "Invalid Date"
        Exit Function
    End If

    ' Determine the initial number of years by subtracting the first and
    ' second year.
    years = endyrf - styrf

    ' Look at the month and day values to make sure a full year has passed.
    If stmonf > endmonf Then
        years = years - 1
    End If

If stmonf = endmonf And stdayf > enddayf Then
        years = years - 1
    End If

    ' Make sure that we are not returning a negative number and, if not,
    ' return the years.
    If years < 0 Then
        AgeFunc = "Invalid Date"
    Else
        AgeFunc = years
    End If

End Function

' This is a second function that the first will call.
' It runs the Search worksheet function with arguments passed from AgeFunc.
' It is used so that the code is easier to read.
Public Function sfunc(x As Variant, y As Variant, Optional z As Variant)
    sfunc = Application.WorksheetFunction.Search(x, y, z)
End Function

Public Function CalculoEdad(FechaNacimiento As Variant, FechaFinal As Variant, CertificadoFinal As String)
Dim FechaNacimientoFormateada As String
Dim FechaFinalFormateada As String
    FechaNacimientoFormateada = Format(FechaNacimiento, "m/d/yyyy") 'Esto permite que, si es una fecha anterior a 1900, no de error
    If CertificadoFinal = "-" Then
        FechaFinalFormateada = Format(Date, "m/d/yyyy") 'Esto permite que, si es una fecha anterior a 1900, no de error
        CalculoEdad = AgeFunc(FechaNacimientoFormateada, FechaFinalFormateada)
    ElseIf CertificadoFinal = "" Then
        CalculoEdad = ""
    Else
        FechaFinalFormateada = Format(FechaFinal, "m/d/yyyy") 'Esto permite que, si es una fecha anterior a 1900, no de error
        CalculoEdad = AgeFunc(FechaNacimientoFormateada, FechaFinalFormateada)
    End If
End Function

Por cierto, no puedo valorarte hoy las respuestas porque he llegado al límite. Me pongo una nota para mañana hacerlo.

Link to post
Share on other sites

Estoy probando las dos funciones.

Si utilizo ObtenerEdad, con las fechas 18-nov-1899 y 6-sep-1980, me da como edad 81, lo que es incorrecto.

Si utilizo restarfechas, tengo que darle formato ("aa") para que me muestre los años. Con las dos fechas anteriores, sí que saca 80, que es el valor correcto. Eso, o cambiar el formato del DateDiff a "y".

Edited by zelarra821
Link to post
Share on other sites
Hace 1 hora, zelarra821 dijo:

Estoy probando las dos funciones.

Si utilizo ObtenerEdad, con las fechas 18-nov-1899 y 6-sep-1980, me da como edad 81, lo que es incorrecto.

Si utilizo restarfechas, tengo que darle formato ("aa") para que me muestre los años. Con las dos fechas anteriores, sí que saca 80, que es el valor correcto. Eso, o cambiar el formato del DateDiff a "y".

Esa función que has encontrado en la Web está pensada para fechas en formato americano: MM/DD/YYYY y no creo que te funcione para fechas con tu formato.

Lo del formato de celda "aa" no te lo aconsejo, pues si el valor es mayor que 99 te dará un valor incorrecto.

DateDiff a "y" es equivalente a "d" por lo que cuenta días y tampoco te servirá.

Me acabo de enterar estudiando la función DateDiff que para años ("yyyy") devuelve 1 aunque solo haya transcurrido un día. ¡Y ese es el problema de contar un año de más!

He modificado la función para corregir la edad (no es tan compleja como la que te bajaste de Internet):

Function ObtenerEdad(sFecha1 As String, sFecha2 As String) As Long
'
' Obtiene la diferencia en años entre dos fechas en formato Long
' Argumentos: sFecha1 y sFecha2 con las fechas a restar en formato String
' Rango de fechas desde el 1 de enero de 100 hasta el 31 de diciembre de 9999.
'
' Funciones VBA: DateValue y DateDiff("yyyy",date1,date2) Functions
'
    Dim dtFecha1 As Date
    Dim dtFecha2 As Date
    Dim dtMesDía1 As Date
    Dim dtMesDía2 As Date
    Dim lDías As Long
    Dim iCorregirAño As Integer
   
    dtFecha1 = DateValue(sFecha1)
    dtFecha2 = DateValue(sFecha2)

    '
    ' Al comparar el 31 de diciembre con el 1 de enero del año inmediatamente siguiente,
    ' DateDiff para el año ("yyyy") devuelve 1 aunque solo haya transcurrido un día.
    ' Por lo que se debe corregir restando un año en estos casos
    '
    If Year(dtFecha1) < Year(dtFecha2) Then
        dtMesDía1 = DateSerial(2001, Month(dtFecha1), Day(dtFecha1))
        dtMesDía2 = DateSerial(2001, Month(dtFecha2), Day(dtFecha2))
        If dtMesDía1 > dtMesDía2 Then
            iCorregirAño = 1
        End If
    End If
    
    ObtenerEdad = DateDiff("yyyy", dtFecha1, dtFecha2) - iCorregirAño
    
End Function

Ejemplo de edades calculadas:

image.thumb.png.5f01537cf0c390111f19581fc4029af5.png

En la última columna he incluido el resultado de tu función: CalculoEdad que creo que sólo funciona con fechas americanizadas... (como comprenderás, no he analizado esa función "AgeFunc" de Internet...)

Link to post
Share on other sites

Buenos días. Ayer no te pude contestar, porque me fue imposible sentarme a ver la función que me habías pasado. Con tu permiso, la he adaptado a mi caso concreto, y la tengo así:

Function Edad(sFechaNacimiento As String, sFecha2 As String, sCertificado As String) As Long
    Dim dtFecha1 As Date
    Dim dtFecha2 As Date
    Dim iCorregirAño As Integer
   
    dtFecha1 = DateValue(sFechaNacimiento)
    If sCertificado = "" Then
        Edad = Null
    ElseIf sCertificado = "-" Then
        dtFecha2 = DateValue(Date)
        iCorregirAño = CorregirAño(dtFecha1, dtFecha2)
        Edad = DateDiff("yyyy", dtFecha1, dtFecha2) - iCorregirAño
    Else
        dtFecha2 = DateValue(sFecha2)
        iCorregirAño = CorregirAño(dtFecha1, dtFecha2)
        Edad = DateDiff("yyyy", dtFecha1, dtFecha2) - iCorregirAño
    End If
End Function

Function CorregirAño(dtFecha1 As Date, dtFecha2 As Date) As Integer
    Dim dtMesDia1 As Date
    Dim dtMesDia2 As Date
    Dim iCorregirAño As Integer
    If Year(dtFecha1) < Year(dtFecha2) Then
        dtMesDia1 = DateSerial(2001, Month(dtFecha1), Day(dtFecha1))
        dtMesDia2 = DateSerial(2001, Month(dtFecha2), Day(dtFecha2))
        If dtMesDia1 > dtMesDia2 Then
            CorregirAño = 1
        End If
    End If
End Function

Ahora bien, tengo tres preguntas:

  1. Esa variable sCertificado es una celda en la que pongo si tengo o no el certificado, bien porque no lo encuentro (la celda tiene como valor ""), porque aún vive ("-"), o porque ya lo tengo ("x"), ya que va a determinar el valor de sFecha2 (si aún vive, la fecha que tiene que coger es la actual). Independientemente de que pudiera usar un Select Case en vez de un If..., cuando el valor de la celda es "", me tira el error #¡VALOR!. Yo creo que está relacionado con el tipo de variable, que es long, pero no sé cómo arreglarlo.
  2. A modo de curiosidad, ¿porque, cuando corriges el año (dtMesDia1 = DateSerial(2001, Month(dtFecha1), Day(dtFecha1))), utilizas el año 2001? Ese año no es bisiesto, y si tienes algún 29 de febrero, ya la has liado.
  3. Y otra a modo de curiosidad. Si en la fórmula de la celda pongo, utilizando la función que yo he readaptado, =edad(E11;hoy();M11), VBA no reconoce sFecha2, porque le estoy metiendo otra función. ¿Cómo podría comprobar si en donde debería haber una fecha con formato string hay una fórmula, y, por tanto, devolver el resultado de hoy() para luego ya sí usarlo en sFecha2 como String?

¡Gracias!

Link to post
Share on other sites
Hace 1 hora, zelarra821 dijo:
  1. Esa variable sCertificado es una celda en la que pongo si tengo o no el certificado, bien porque no lo encuentro (la celda tiene como valor ""), porque aún vive ("-"), o porque ya lo tengo ("x"), ya que va a determinar el valor de sFecha2 (si aún vive, la fecha que tiene que coger es la actual). Independientemente de que pudiera usar un Select Case en vez de un If..., cuando el valor de la celda es "", me tira el error #¡VALOR!. Yo creo que está relacionado con el tipo de variable, que es long, pero no sé cómo arreglarlo.

Para solucionar eso, he cambiado de Long a Variant. No sé si habrá otra posible solución.

Link to post
Share on other sites

Respuestas:

  1. Es conveniente mantener la función Edad como Long. Si sCertificado es "" entonces Edad=-1. Para los valores negativos devueltos como Edad se formatea el número de las celdas como: #.##0;"¿?" (valores negativos se muestran como: ¿?)
  2. Gracias por la observación, aunque no creo que la hay liado por eso. He sustituido el año de referencia por uno bisiesto: DateSerial(2000, 
  3. He incluido en la función Edad el chequeo de fechas numéricas además de fechas en formato texto. Considero que las celdas marcadas en color naranja no tienen sentido pues con Certificado = "-" no hace falta poner la fecha actual como fecha del certificado ni llamar a la función Edad con una función incrustada como HOY()...

Prueba el adjunto.

Edad Certificado PW1.xlsm

Link to post
Share on other sites
Hace 47 minutos , zelarra821 dijo:

Vale. Casi.

Te adjunto el fichero. Hay una opción que no has contemplado, y te he hecho un comentario al valor ¿?.

¡Gracias!

Edad Certificado PW1.xlsm 20.15 kB · 0 descargas

a) Formato de los números de celda para la edad mostrada como vacía: #.##0;""

b) Opción contemplada en la función Edad si no se introduce la fecha de nacimiento:

    If sFechaNacimiento = "" Then
        ' Sin fecha de nacimiento
        Edad = -3
 

Adjunto archivo con las evidencias:

Edad Certificado PW2.xlsm

Link to post
Share on other sites

Estudia el siguiente enlace para entender los códigos de formato de número personalizados:

https://support.microsoft.com/es-es/office/códigos-de-formato-de-número-5026bbd6-04bc-48cd-bf33-80f18b4eae68

Con el formato personalizado: #.##0;"" todos los números negativos se mostrarán como vacíos, pues se especifica el Imagen del botón Formato de los números negativos.

Como he especificado dos secciones de código de formato, la primera sección de código se utiliza para números positivos y ceros y la segunda sección del código se usa para los números negativos.

El formato de número no afecta al valor real de la celda que usa Excel para realizar los cálculos. El valor real se muestra en la barra de fórmulas.

Espero haber contestado satisfactoriamente y hagas clic en el icono con un "Corazón".

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Crear macros Excel

  • Posts

    • Hola, podrían ayudarme con una formula simple para poder sumar desde una posición a otra, gracias sumas desde hasta.xlsx
    • Buenas noches. Maestros quisiera saber si se puede volver dinámico el rango a la derecha la propiedad RowSource de un ListBox. Es que tengo una base de datos a la cual de vez en cuando se le agregan columnas nuevas y quisiera se ampliara la selección a la derecha como lo hace hacia abajo. Ejemplo  ListBox1.RowSource = "A4:End(xlToRight)" & Range("A3").End(xlDown).Row Algo así, no se si se podrá.
    • Hola amigos, alguién tendrá un videotutorial o tutorial de como usar EXCEL VBA y MySQL para realizar insertar, guardar, borrar, modificar y actualizar desde formularios en vba o formularios en hojas de excel? he buscado ya por mucho en la web, y solo existe poca información y no me da claridad en el proceso de aprendizaje, si uds me pudieran brindar algún proyecto de ejemplo, o enlazarme o compartime un videotutorial, sería bueno para iniciar mi proyecto. Quedo abierto a sus comentarios y sugerencias
    • Buenas chicos tengo el siguiente problemilla. Mediante una macro intento acceder a un archivo csv. delimtado con puntos y comas. y al usar  Workbooks.Open Filename:="C:\Users\pc\Desktop\stock.csv"   me la abre mal    Si la abro normal me la abre perfectamente, he intentado un par de cosillas pero nada fracaso total. Si podéis arrojarme un poco de luz sobre esto os lo agradecería mucho. Un saludo.      
    • Hola amigos, espero se encuentren bien, quiero comentarles que acabo de realizar un pequeño archivo donde en una hoja tengo una tabla (pudiendo contener mas de 10,000 registros) que deseo imprimir en etiquetas, es un registro por etiqueta, para lo cuál usé la función CICLO FOR en vba y generar así la impresión. Mi impresora actual es una TSC ttp244pro,  según lo que sé es que esta impresora no tiene mucha capacidad de memoria para guardar o para imprimir, por lo que las impresiones salen lentas. Me gustaría saber si alguien sabe como mejorar la macros para que pueda imprimir más rápido ya que en la cola de impresión un trabajo por etiqueta, no sé si exista forma de enviar un solo trabajo y que pueda así imprimir más rápido. Mil disculpas si las macros que verán tiene demasiado código para lo que hago. Saludos Cordial Walter   proyecto.xlsm
  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy