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
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
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 FunctionCon 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