Option Explicit
Sub pp()
Dim a As Long, Car(11), Hora(11, 86400), Fecha As String, _
b As Long, Fila As Long, Desde As Long, Hasta As Long, _
Pos As Long, sw As Integer, Coches As String, Tipos As String
For b = 0 To 86400: For a = 1 To 11: Hora(a, b) = "": Next: Next
Sheets("Report").Select:
Fila = 9: Fecha = Format(Cells(Fila, 3), "YYYY.MM.DD")
While Cells(Fila, 3) <> ""
If Fecha <> Format(Cells(Fila, 3), "YYYY.MM.DD") Then
Open "C:\Tmp\" + Fecha + ".txt" For Output As #1
Desde = 0
Hasta = 0
For b = 0 To 86400
DoEvents
sw = 0
For a = 1 To 11
If Hora(a, b) = "*" Then sw = sw + 1
Next
If sw = 11 Then
If Desde = 0 Then
Desde = b: Print #1, Format(Desde / 86400, "hh:mm:ss"); ";";
Else
Hasta = b
End If
Else
If Desde > 0 Then
Print #1, Format(Hasta / 86400, "hh:mm:ss"): Desde = 0: Hasta = 0
End If
End If
Next
Close
For b = 0 To 86400: For a = 1 To 11: Hora(a, b) = "": DoEvents: Next: Next
Fecha = Format(Cells(Fila, 3), "YYYY.MM.DD")
End If
Desde = Int((Cells(Fila, 3) - Int(Cells(Fila, 3))) * 86400)
Hasta = Int((Cells(Fila, 4) - Int(Cells(Fila, 4))) * 86400)
Pos = 0
For a = 1 To 11
DoEvents
If Car(a) = Cells(Fila, 1) Then Pos = a: Exit For
If Car(a) = "" Then Car(a) = Cells(Fila, 1): Pos = a: Exit For
Next
For a = Desde To Hasta
Hora(Pos, a) = "*"
Next
Fila = Fila + 1
Wend
Open "C:\Tmp\" + Fecha + ".txt" For Output As #1
Desde = 0
Hasta = 0
For b = 0 To 86400
sw = 0: DoEvents
For a = 1 To 11
If Hora(a, b) = "*" Then sw = sw + 1
Next
If sw = 11 Then
If Desde = 0 Then
Desde = b: Print #1, Format(Desde / 86400, "hh:mm:ss"); ";";
Else
Hasta = b
End If
Else
If Desde > 0 Then
Print #1, Format(Hasta / 86400, "hh:mm:ss"): Desde = 0: Hasta = 0
End If
End If
Next
Close
MsgBox "FIN"
End Sub
