Calculo de tiempo transcurrido entre fechas horas
Necesito calcular el tiempo transcurrido entre dos fechas el resultado del calculo debería incluir el tiempo en horas y días. Tengo la siguiente código para ingresar datos, trate de hacer el calculo pero no logro que funcione.
Option Explicit
Private Sub CargarAgregar_Click()
'Definición de variables
Dim iFila As Long
Dim ws As Worksheet
Set ws = Worksheets(1)
Dim productos As Range
Set productos = Hoja2.Range("F4:F103")
'ENCONTRAR LA SIGUIENTE FILA VACIA
iFila = ws.Cells(rows.Count, 2).End(xlUp).Offset(1, 0).Row
'VERIFICAR QUE SE INGRESE DATO
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Debe ingresar Fecha de recepción"
Exit Sub
End If
'COPIAR DATOS EN MATRIZ
'Fila 1=fecha de recepción
ws.Cells(iFila, 2).Value = Me.TextBox1.Value
'Fila 2 Hora de recepción
ws.Cells(iFila, 3).Value = Me.TextBox7.Value
'Turno fila 4
If Diurno.Value = True Then
ws.Cells(iFila, 4).Value = "Diurno"
End If
If Nocturno.Value = True Then
ws.Cells(iFila, 4).Value = "Nocturno"
End If
If SobreTiempo.Value = True Then
ws.Cells(iFila, 4).Value = "Sobre tiempo"
End If
'Fila 5Insertar firma de usuario
ws.Cells(iFila, 5).Value = Environ("Username")
'Fila 6 lista de productos
ws.Cells(iFila, 6).Value = Me.Listaproductos.Value
'Fila 7= lote
ws.Cells(iFila, 7).Value = Me.TextBox3.Value
ws.Cells(iFila, 28).Value = "1"
'Fila 8=Fase
If Fabricacion.Value = True Then
ws.Cells(iFila, 8).Value = "Fabricación"
End If
If Envase.Value = True Then
ws.Cells(iFila, 8).Value = "Envase"
End If
If Empaque.Value = True Then
ws.Cells(iFila, 8).Value = "Empaque"
End If
If Maquila.Value = True Then
ws.Cells(iFila, 8).Value = "Maquila"
End If
'Fila 9=Tipo de Entrega
If Total.Value = True Then
ws.Cells(iFila, 9).Value = "Total"
End If
If Parcial.Value = True Then
ws.Cells(iFila, 9).Value = "Parcial"
End If
'Fila 10 hasta 16 Desviaciones
If TextboxDesviacion1.Value = "" Then
ws.Cells(iFila, 10).Value = "0"
Else
ws.Cells(iFila, 10).Value = Me.TextboxDesviacion1.Value
End If
If TextBoxDesviacion2.Value = "" Then
ws.Cells(iFila, 11).Value = "0"
Else
ws.Cells(iFila, 11).Value = Me.TextBoxDesviacion2.Value
End If
If TextBoxDesviacion3.Value = "" Then
ws.Cells(iFila, 12).Value = "0"
Else
ws.Cells(iFila, 12).Value = Me.TextBoxDesviacion3.Value
End If
If TextBoxDesviacion4.Value = "" Then
ws.Cells(iFila, 13).Value = "0"
Else
ws.Cells(iFila, 13).Value = Me.TextBoxDesviacion4.Value
End If
If TextBoxDesviacion5.Value = "" Then
ws.Cells(iFila, 14).Value = "0"
Else
ws.Cells(iFila, 14).Value = Me.TextBoxDesviacion5.Value
End If
If TextBoxDesviacion6.Value = "" Then
ws.Cells(iFila, 15).Value = "0"
Else
ws.Cells(iFila, 15).Value = Me.TextBoxDesviacion6.Value
End If
If TextBoxDesviacion7.Value = "" Then
ws.Cells(iFila, 16).Value = "0"
Else
ws.Cells(iFila, 16).Value = Me.TextBoxDesviacion7.Value
End If
'Fila 17 hasta 18 Acción
If AccionDevuelto.Value = True Then
ws.Cells(iFila, 17).Value = "Si"
Else: ws.Cells(iFila, 17).Value = "No"
End If
If AccionRNC.Value = True Then
ws.Cells(iFila, 18).Value = "Si"
Else: ws.Cells(iFila, 18).Value = "No"
End If
'Fila 19 Observaciones
ws.Cells(iFila, 19).Value = Me.TextBox4.Value
'Fila 20 Fecha Devolución
If Me.TextBox5.Value = "" Then
ws.Cells(iFila, 20).Value = "Sin devolución"
End If
'Fila 21 Hora de la devolución
If Me.TextBox9.Value = "" Then
ws.Cells(iFila, 21).Value = "No aplica"
Else: ws.Cells(iFila, 21).Value = Me.TextBox9.Value
End If
'Fila 22 Fecha recepción correción
If Me.TextBox2.Value = "" Then
ws.Cells(iFila, 22).Value = "No aplica"
Else: ws.Cells(iFila, 22).Value = Me.TextBox2.Value
End If
'Fila 23 Hora recepción correción
If Me.TextBox10.Value = "" Then
ws.Cells(iFila, 23).Value = "No aplica"
Else: ws.Cells(iFila, 23).Value = Me.TextBox10.Value
End If
'Fila 24 Calculo tiempo transito de corrección ver abajo
If Me.TextBox9.Value = "" Then
ws.Cells(iFila, 24).Value = "0"
End If
'Fila 25 Fecha entrega a garantia
ws.Cells(iFila, 25).Value = Me.TextBox6.Value
'Fila 26 Hora de entrega a garantia
ws.Cells(iFila, 26).Value = Me.TextBox11.Value
End Sub
