Obtener la diferencia de Día, Mes, Año, Minutos y Segundo entre dos fechas

Sres. T.E

El motivo es que desconozco el porque todo los resultados entre las dos fechas son correctas excepto los Días el cual muestra 5.

Resultado: Años 1 Mes 0 Dias 5 Horas 0 Minutos 0 Segundos 0

Fecha Inicial: 01/01/2023 12:10 a.m. Fecha Final: 01/01/2024 12:10 a.m.

Note que el día, mes, hora y minuto son iguales excepto el Año

Esto ejecutado con la siguiente Función.

Function DifEnElTiempoSegmentos(Inicio As Date, Final As Date)
segundos = Abs(Final - Inicio) * 86400
segundos = Round(segundos, 4)
minutos = Int(segundos / 60)
ResiduoSegundos = Abs(segundos - (minutos * 60))
segundos = ResiduoSegundos
horas = Int(minutos / 60)
ResiduoMinutos = Abs(minutos - (horas * 60))
minutos = ResiduoMinutos
dias = Int(horas / 24)
ResiduoHoras = Abs(horas - (dias * 24))
horas = ResiduoHoras
meses = Int(dias / 30)
ResiduoDias = Abs(dias - (meses * 30))
dias = ResiduoDias
anios = Int(meses / 12)
ResiduoMeses = Abs(meses - (anios * 12))
meses = ResiduoMeses
DifEnElTiempoSegmentos = "Años " & CStr(anios & " Mes " & meses & " Dias " & dias & " Horas " & horas & " Minutos " & minutos & " Segundos " & segundos)
Exit Function
End Function

2 Respuestas

Respuesta
1

Pruebe con esta función

Function DiferenciaFechas(fechaInicio As Date, fechaFin As Date) As String
    Dim diferencia As Double
    Dim diferenciaDias As Integer
    Dim diferenciaMeses As Integer
    Dim diferenciaAnios As Integer
    Dim diferenciaHoras As Integer
    Dim diferenciaMinutos As Integer
    Dim diferenciaSegundos As Integer
    ' Calcula la diferencia total en días
    diferencia = fechaFin - fechaInicio
    diferenciaDias = Int(diferencia)
    ' Calcula la diferencia en meses y años
    diferenciaAnios = Year(fechaFin) - Year(fechaInicio)
    diferenciaMeses = Month(fechaFin) - Month(fechaInicio)
    If diferenciaMeses < 0 Then
        diferenciaAnios = diferenciaAnios - 1
        diferenciaMeses = diferenciaMeses + 12
    End If
    ' Calcula la diferencia en horas, minutos y segundos
    diferenciaHoras = Hour(fechaFin - fechaInicio)
    diferenciaMinutos = Minute(fechaFin - fechaInicio)
    diferenciaSegundos = Second(fechaFin - fechaInicio)
    ' Construye la cadena de texto con la diferencia de fechas
    DiferenciaFechas = diferenciaDias & " días, " & diferenciaMeses & " meses, " & diferenciaAnios & " años, " & _
                       diferenciaHoras & " horas, " & diferenciaMinutos & " minutos, " & diferenciaSegundos & " segundos"
End Function

¡Gracias! 

Por precisa y pronta repuesta, analizare las diferencia entre la función enviada y recibida.

Gracias de nuevo 

Respuesta

Aquí te proporciono una función alternativa para calcular la diferencia de días, meses, años, minutos y segundos entre dos fechas:

Function DifEnElTiempoSegmentos(Inicio As Date, Final As Date) As String
    Dim totalSegundos As Long
    Dim anios As Long, meses As Long, dias As Long, horas As Long, minutos As Long, segundos As Long
    totalSegundos = DateDiff("s", Inicio, Final)
    anios = DateDiff("yyyy", Inicio, Final)
    meses = DateDiff("m", DateAdd("yyyy", anios, Inicio), Final)
    dias = DateDiff("d", DateAdd("m", meses, DateAdd("yyyy", anios, Inicio)), Final)
    horas = DateDiff("h", DateAdd("d", dias, DateAdd("m", meses, DateAdd("yyyy", anios, Inicio))), Final)
    minutos = DateDiff("n", DateAdd("h", horas, DateAdd("d", dias, DateAdd("m", meses, DateAdd("yyyy", anios, Inicio)))), Final)
    Segundos = DateDiff("s", DateAdd("n", minutos, DateAdd("h", horas, DateAdd("d", dias, DateAdd("m", meses, DateAdd("yyyy", anios, Inicio))))), Final)
    DifEnElTiempoSegmentos = "Años " & CStr(anios) & " Meses " & CStr(meses) & " Días " & CStr(dias) & " Horas " & CStr(horas) & " Minutos " & CStr(minutos) & " Segundos " & CStr(segundos)
End Function

Con esta nueva función, deberías obtener los resultados correctos para las fechas que has proporcionado:

Sub Test()
    Dim fechaInicial As Date
    Dim fechaFinal As Date
    fechaInicial = #01/01/2023 12:10:00 AM#
    fechaFinal = #01/01/2024 12:10:00 AM#
    MsgBox DifEnElTiempoSegmentos(fechaInicial, fechaFinal)
End Sub

El resultado debería ser: "Años 1 Meses 0 Días 0 Horas 0 Minutos 0 Segundos 0".

Hola Rafael.

He creado una tabla y he ejecutado tu código.
el cual me muestra el mensaje siguiente:
Error de compilación:
No se ha definido Sub o Función.

Como corregir este mensaje erróneo?

Rafael se me paso por alto mencionar cual de los códigos se trata del que tiene la Función 

DifEnElTiempoSegmentos

Aquí tienes una versión corregida de la función que calculará correctamente la diferencia en días, meses, años, minutos y segundos entre dos fechas:

Function DifEnElTiempoSegmentos(Inicio As Date, Final As Date) As String
    Dim segundos As Double
    Dim minutos As Double
    Dim horas As Double
    Dim dias As Long
    Dim meses As Long
    Dim anios As Long
    segundos = Abs(Final - Inicio) * 86400
    segundos = Round(segundos, 4)
    minutos = Int(segundos / 60)
    segundos = segundos Mod 60
    horas = Int(minutos / 60)
    minutos = minutos Mod 60
    dias = Int(horas / 24)
    horas = horas Mod 24
    meses = DateDiff("m", Inicio, Final) Mod 12
    anios = DateDiff("yyyy", Inicio, Final)
    DifEnElTiempoSegmentos = "Años " & anios & " Mes " & meses & " Dias " & dias & " Horas " & horas & " Minutos " & minutos & " Segundos " & segundos
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas