Подсчет интервалов времени (проблемка)

[Penumbra]

Здравствуйте господа, у меня проблемка с подсчетам временного интервала между метками времени:
есть коллекция записей состоящая из временных меток

Код: Выделить всё

            ListsDate.Add "start", "21.01.2015 08:30:15", 1
          '  ListsDate.Add "stop", "21.01.2015 09:50:15", 1
          ListsDate.Add "stop", "21.01.2015 10:15:15", 2
            ListsDate.Add "start", "21.01.2015 11:55:05", 1
            ListsDate.Add "stop", "21.01.2015 13:20:00", 2
            ListsDate.Add "start", "21.01.2015 13:45:15", 1
            ListsDate.Add "stop", "21.01.2015 16:15:04", 2
            ListsDate.Add "start", "21.01.2015 17:30:15", 4
            ListsDate.Add "stop", "21.01.2015 19:17:15", 4
            ListsDate.Add "start", "21.01.2015 21:30:37", 4
            ListsDate.Add "stop", "22.01.2015 02:59:15", 4
            ListsDate.Add "start", "22.01.2015 03:30:55", 3
            ListsDate.Add "stop", "22.01.2015 06:15:15", 3
            ListsDate.Add "start", "22.01.2015 07:30:15", 1
            ListsDate.Add "stop", "22.01.2015 10:15:15", 2

Мне надо подсчитать временной интервал между отметками start и stop" за определенный период. Написал код, вроде работает НО неправильно считает если конец запрашиваемого периода попадает между отметками start и stop
где закралась ошибка не знаю, уже головной моСк кипит, прошу помощи в поиске ошибки
Вот код:
П.С. здесь вместо UDT AddNewDate использую класс AddNewDate и класс-коллекцию ColNewDate, весь код в архиве

Код: Выделить всё

Dim ListsDate As ColNewDate
    Dim tmDate As AddNewDate
    Dim minOn As Integer
     Dim minOFF As Integer
   
Sub addd()
    On Error GoTo ErrorHandler
    Set ListsDate = New ColNewDate
    Set tmDate = New AddNewDate
   
  '=============================================================
            ListsDate.Add "start", "21.01.2015 08:30:15", 1
          '  ListsDate.Add "stop", "21.01.2015 09:50:15", 1
          ListsDate.Add "stop", "21.01.2015 10:15:15", 2
            ListsDate.Add "start", "21.01.2015 11:55:05", 1
            ListsDate.Add "stop", "21.01.2015 13:20:00", 2
            ListsDate.Add "start", "21.01.2015 13:45:15", 1
            ListsDate.Add "stop", "21.01.2015 16:15:04", 2
            ListsDate.Add "start", "21.01.2015 17:30:15", 4
            ListsDate.Add "stop", "21.01.2015 19:17:15", 4
            ListsDate.Add "start", "21.01.2015 21:30:37", 4
            ListsDate.Add "stop", "22.01.2015 02:59:15", 4
            ListsDate.Add "start", "22.01.2015 03:30:55", 3
            ListsDate.Add "stop", "22.01.2015 06:15:15", 3
            ListsDate.Add "start", "22.01.2015 07:30:15", 1
            ListsDate.Add "stop", "22.01.2015 10:15:15", 2
   '=============================================================
   
    Exit Sub
ErrorHandler:
    MsgBox Error, vbExclamation + vbOKOnly
End Sub

Sub tipBDLoad(Optional ByVal Index As Integer = 0, Optional ByVal tmn1 As Date, Optional ByVal tmn2 As Date, Optional ByVal txt As String)
    '   On Error Resume Next
    Dim stp As Boolean, e1 As Boolean, tmp As Date, tmp1 As Long
    Dim strlDate As String
    Dim I As Integer, lastindex As Integer
    Dim y As Integer
    Dim b1 As Boolean, b0 As Boolean, e0 As Boolean
    Dim tempmax1  As Integer, S  As Long, tmplastOn, Work As Long, sCount, sekOn As Long, sekOff As Long, NotWork As Long, lDate, lDateerr, lsrt

    S = 0
    tmplastOn = False
   
    sekOn = 0
    sekOff = 0
    stp = True
    For Each tmDate In ListsDate
        I = I + 1
        ' перебераем коллекцию записей
        ' .
        If tmDate.Parametrs = "start" And stp = True Then
            b1 = True
            stp = False
            lDate = tmDate.Dates
            strlDate = tmDate.Dates
            tempmax1 = tmDate.Num
        End If
        If tmDate.Parametrs = "stop" And b1 = True Then
            sekOn = sekOn + DateDiff("s", lDate, tmDate.Dates)
            b1 = False
            lsrt = (tmDate.Dates)
            stp = True
        End If
        If CDate(ListsDate(I).Dates) >= CDate(tmn2) Then
            lastindex = I
            Exit For
        End If
    Next
   
    If ListsDate(lastindex).Parametrs = "start" Then
        tmp1 = DateDiff("s", lDate, tmn2)
        sekOn = sekOn + tmp1
       
    End If
   
    If ListsDate(lastindex).Parametrs = "stop" And CDate(ListsDate(lastindex).Dates) > CDate(tmn2) Then
       
        tmp1 = DateDiff("s", tmn2, ListsDate(lastindex).Dates)
        sekOn = sekOn - tmp1
       
    End If
   
    tmp1 = DateDiff("s", tmn1, tmn2)
    sekOff = tmp1 - sekOn
   
    If sekOn > 0 Then
        Work = sekOn \ 60 '+ minOn
    Else
        Work = 0
    End If
    If sekOff > 0 Then
        NotWork = sekOff \ 60 '+ minOFF
    Else
        NotWork = 0
    End If
'   If Work >= 1440 Then Work = 1439
  ''  If NotWork >= 1440 Then NotWork = 1439
    Text1.Text = Text1.Text & vbNewLine
    Text1.Text = Text1.Text & vbNewLine & "Время работы за " & txt & Format(TimeSerial(0, Work - minOn, 0), " hh ч. mm мин.")
    Text1.Text = Text1.Text & vbNewLine & "Время простоя за " & txt & Format(TimeSerial(0, NotWork - minOFF, 0), " hh ч. mm мин.")
    minOn = Work
      minOFF = NotWork
End Sub

Private Sub Command1_Click()
  '  On Error GoTo ErrorHandler
Call addd
minOn = 0
minOFF = 0
Text1.Text = ""
Call tipBDLoad(, "21.01.2015 08:00:00", "21.01.2015 14:00:00", " за 1 смену")
Call tipBDLoad(, "21.01.2015 08:00:00", "21.01.2015 20:00:00", " за 2 смену")
Call tipBDLoad(, "21.01.2015 08:00:00", "22.01.2015 02:00:00", " за 3 смену  - вот тут неправильно считает")
Call tipBDLoad(, "21.01.2015 08:00:00", "22.01.2015 08:00:00", " за 4 смену")


  Text1.Text = Text1.Text & vbNewLine
  Text1.Text = Text1.Text & vbNewLine & "Время работы за " & Format(TimeSerial(0, minOn, 0), " hh ч. mm мин.")
  Text1.Text = Text1.Text & vbNewLine & "Время простоя за " & Format(TimeSerial(0, minOFF, 0), " hh ч. mm мин.")

    Exit Sub
ErrorHandler:
    MsgBox Error, vbExclamation + vbOKOnly
End Sub


[pronto]

Если в строке ListsDate.Add "start", "21.01.2015 08:30:15", 1 последний параметр — это номер смены, то почему I-я смена только «стартует»:

Код: Выделить всё

ListsDate.Add "start", "21.01.2015 11:55:05", 1
ListsDate.Add "start", "21.01.2015 13:45:15", 1
ListsDate.Add "start", "22.01.2015 07:30:15", 1

Как-то нелогично получается, если нужно подсчитать время простоя и полезной работы за смену. По идее "start" и "stop" должны чередоваться.
Tпростоя = сумма всех периодов ("start" - "stop")
Tработа = Tсмены - Tпростоя

[Penumbra]

в том то и проблема что записи могут задваиваться из-за проблем со связью с устройством , но мне надо игнорировать задвоения,
да, забыл сказать что на последний параметр можно не смотреть, то спец параметр передаваемый от устройства к программе и используется далее в проге. В этом примере он не несет никакой смысловой нагрузки, можно сказать что его нет

[Хакер]

Стоп. Даже если в реализации идеи есть ошибка, сначала надо подумать о самой идее.
Так вот. Это вообще в принципе неправильно: проводить хоть какую-то арифметику с датами, хранящимися в текстовом формате.

[pronto]

В III смену простой должен составить 06 ч. 03 мин., а рабочее время: 11 ч. 56 мин.?

PS При исходных данных, какое время считать правильным для каждой смены? (лень считать вручную)

[azimut87]

В III смену простой должен составить 06 ч. 03 мин., а рабочее время: 11 ч. 56 мин.?

PS При исходных данных, какое время считать правильным для каждой смены? (лень считать вручную)

А вы не ленитесь, если желаете достичь успеха в каком-то деле.

[Penumbra]

Хакер да, точно, поправил
pronto должно получится считал в ручную)

Код: Выделить всё

Время работы за  за 1 смену 03 ч. 24 мин.
Время простоя за  за 1 смену 02 ч. 35 мин.

Время работы за  за 2 смену 04 ч. 02 мин.
Время простоя за  за 2 смену 01 ч. 57 мин.

Время работы за  за 3 смену  04 ч. 29 мин.
Время простоя за  за 3 смену  01 ч. 30 мин.

Время работы за  за 4 смену 04 ч. 13 мин.
Время простоя за  за 4 смену 01 ч. 46 мин.

Время работы за  16 ч. 09 мин.
Время простоя за  07 ч. 50 мин.

смены:
1 -08:00 -14:00
2 - 14:00-20:00
3 - 20:00-02:00
4 -02:00-08:00

[pronto]

Ага, всё правильно...
Очевидно, что костяком алгоритма должен стать цикл перебора всех элементов. OK

Код: Выделить всё

For i = 1 To ListsDate.Count
Next i


Внутри цикла полюбому нужно знать, попадает ли текущий элемент (момент времени старт/стоп) в диапазон смены. OK

Код: Выделить всё

' все переменные должны быть предварительно объявлены (не забывай про опцию «Option Explicit»)
Dim TurnBegin As Date, TurnEnd As Date ' начало и конец смены
Dim SS_Moment As Date ' момент старта/стопа
For i = 1 To ListsDate.Count
   SS_Moment = CDate(ListsDate.Item(i).Dates)
   
   If SS_Moment > TurnBegin And SS_Moment < TurnEnd Then
     
   End If
Next i


На основе простой логики понятно, что если первый момент смены с отметкой «start», то время от начала смены до этого момента нужно считать за простой. А если «stop» — то за работу:

Код: Выделить всё

Dim TurnBegin As Date, TurnEnd As Date ' начало и конец смены
Dim SS_Moment As Date ' момент старта/стопа
' тут нужно ввести ещё несколько переменных
Dim IdleDuration As Long, WorkDuration As Long ' продолжительность простоя и работы в секундах
Dim WorkBegin As Date, WorkEnd As Date ' момент начала работы (метка «start»), момент остановки работы (метка «stop»)

For i = 1 To ListsDate.Count
   SS_Moment = CDate(ListsDate.Item(i).Dates)
   
   If SS_Moment > TurnBegin And SS_Moment < TurnEnd Then
   
      If ListsDate.Item(i).Parametrs = "start" Then
         IdleDuration = IdleDuration + DateDiff("S", WorkEnd, SS_Moment, vbMonday)
         WorkBegin = SS_Moment
      End If
     
      If ListsDate.Item(i).Parametrs = "stop" Then
         WorkDuration = WorkDuration + DateDiff("S", WorkBegin, SS_Moment, vbMonday)
         WorkEnd = SS_Moment
      End If
   End If
Next i

Вот. Получилось нечто такое, от чего можно отталкиваться и продолжать развивать мысль...
Представь первый проход по участку кода IdleDuration = IdleDuration + DateDiff("S", WorkEnd, SS_Moment, vbMonday). Переменной WorkEnd ещё ничего не присвоено — получается переполнение. Следовательно, ещё до основного цикла она должна как-то определяться. Та же история со строкой WorkDuration = WorkDuration + DateDiff("S", WorkBegin, SS_Moment, vbMonday)... Так как первым моментом в смене может быть либо «start» либо «stop», то:

Код: Выделить всё

WorkBegin = TurnBegin
WorkEnd = TurnBegin

Уже что-то начинает получаться, ага. Теперь представь последний момент в смене. Он тоже может быть и с отметкой «start» и с отметкой «stop». В таком случае, от «start» до конца смены — это время работы, а от «stop» — время простоя.

Код: Выделить всё

If ListsDate.Item(i).Parametrs = "stop" Then
   IdleDuration = IdleDuration + DateDiff("S", WorkEnd, TurnEnd, vbMonday)
Else
   WorkDuration = WorkDuration + DateDiff("S", WorkBegin, TurnEnd, vbMonday)
End If

Здесь встаёт необходимость выхода из цикла на последнем «моменте» смены.
Первая мысль — условие If SS_Moment > TurnBegin And SS_Moment < TurnEnd Then дополнить веткой Else:

Код: Выделить всё

   If SS_Moment > TurnBegin And SS_Moment < TurnEnd Then
   
      If ListsDate.Item(i).Parametrs = "start" Then
         IdleDuration = IdleDuration + DateDiff("S", WorkEnd, SS_Moment, vbMonday)
         WorkBegin = SS_Moment
      End If
     
      If ListsDate.Item(i).Parametrs = "stop" Then
         WorkDuration = WorkDuration + DateDiff("S", WorkBegin, SS_Moment, vbMonday)
         WorkEnd = SS_Moment
      End If
   Else
      Exit For
   End If

Непродолжительная медитация подсказывает, что это не будет работать корректо, так как перебор в основном цикле идёт с первого элемента. И если нас интересует вторая и тд смены, то будет преждевременный выход из цикла. Ладно, тогда нужно определять индекс первого и последнего момента в смене отдельно:

Код: Выделить всё

Dim idxFirstMoment As Long, idxLastMoment As Long

For i = 1 To ListsDate.Count
   If CDate(ListsDate.Item(i).Dates) > TurnBegin Then
      idxFirstMoment = i
      Exit For
   End If
Next i
   
For i = idxFirstMoment To ListsDate.Count

   idxLastMoment = i
   
   If CDate(ListsDate.Item(i).Dates) > TurnEnd Then
      idxLastMoment = i - 1
      Exit For
   End If
Next i

Теперь нужно всё собрать вместе:

Код: Выделить всё

Dim i As Long
Dim idxFirstMoment As Long, idxLastMoment As Long

Dim TurnBegin As Date, TurnEnd As Date, TurnDuration As Long ' продолжительность смены в секундах

Dim WorkBegin As Date, WorkEnd As Date
Dim IdleDuration As Long, WorkDuration As Long

Dim SS_Moment As Date ' Start/Stop

'' I смена
'TurnBegin = CDate("21.01.2015 08:00:00")
'TurnEnd = CDate("21.01.2015 14:00:00")

'' II смена
'TurnBegin = CDate("21.01.2015 14:00:00")
'TurnEnd = CDate("21.01.2015 20:00:00")

' III смена
TurnBegin = CDate("21.01.2015 20:00:00")
TurnEnd = CDate("22.01.2015 02:00:00")

'' IV смена
'TurnBegin = CDate("22.01.2015 02:00:00")
'TurnEnd = CDate("22.01.2015 08:00:00")

TurnDuration = DateDiff("S", TurnBegin, TurnEnd, vbMonday)
'Debug.Print TurnDuration

WorkBegin = TurnBegin
WorkEnd = TurnBegin

For i = 1 To ListsDate.Count
   If CDate(ListsDate.Item(i).Dates) > TurnBegin Then
      idxFirstMoment = i
      Exit For
   End If
Next i
   
For i = idxFirstMoment To ListsDate.Count

   idxLastMoment = i
   
   If CDate(ListsDate.Item(i).Dates) > TurnEnd Then
      idxLastMoment = i - 1
      Exit For
   End If
Next i

For i = idxFirstMoment To idxLastMoment
   SS_Moment = CDate(ListsDate.Item(i).Dates)
   
   If ListsDate.Item(i).Parametrs = "start" Then
      IdleDuration = IdleDuration + DateDiff("S", WorkEnd, SS_Moment, vbMonday)
      WorkBegin = SS_Moment
   Else ' ListsDate.Item(i).Parametrs = "stop"
      WorkDuration = WorkDuration + DateDiff("S", WorkBegin, SS_Moment, vbMonday)
      WorkEnd = SS_Moment
   End If
Next i

If ListsDate.Item(i - 1).Parametrs = "stop" Then
   IdleDuration = IdleDuration + DateDiff("S", WorkEnd, TurnEnd, vbMonday)
Else
   WorkDuration = WorkDuration + DateDiff("S", WorkBegin, TurnEnd, vbMonday)
End If

Debug.Print "Продолжительность смены:" + Str$(TurnDuration)
Debug.Print "          рабочее время:" + Str$(WorkDuration)
Debug.Print "                простой:" + Str$(IdleDuration)


Да, неудобно созерцать время в секундах. Пишу коротесенку функцию, преобразующую секунды в запись вида «Х ч. Х мин. Х с.»:

Код: Выделить всё

Function DurationTime(ByVal DurationInSeconds As Long) As String

Dim tH As Long, tM As Long

tH = DurationInSeconds \ 3600
DurationInSeconds = DurationInSeconds Mod 3600

tM = DurationInSeconds \ 60
DurationInSeconds = DurationInSeconds Mod 60

DurationTime = Str$(tH) + " ч." + Str$(tM) + " мин." + Str$(DurationInSeconds) + " c."

End Function

Вывод результата примет вид:

Код: Выделить всё

Debug.Print "Продолжительность смены:" + DurationTime(ByVal TurnDuration)
Debug.Print "          рабочее время:" + DurationTime(ByVal WorkDuration)
Debug.Print "                простой:" + DurationTime(ByVal IdleDuration)


Как-то так...

[Penumbra]

ага, спасибо)
я тут тоже свой код немного развил, вроде правильно считает
в Вашем коде если встречаются задвоение start-ов то неправильно считает
я при задвоении start-ов беру первый а остальные откидываю, а при задвоении стопов беру последний, но глюк возникает если за выбранный период не было записей
ListsDate.Add "stop", "20.01.2015 01:15:04", 2
ListsDate.Add "start", "20.01.2015 01:30:15", 4
ListsDate.Add "stop", "25.01.2015 19:17:15", 4
ListsDate.Add "start", "25.01.2015 21:30:37", 4

[pronto]

С «задвоениями» я не собирался бороться — оставил тебе. А с отсутствием записей мой способ вроде бы справляется:
Для списка

Код: Выделить всё

ListsDate.Add "stop", "20.01.2015 01:15:04", 2
ListsDate.Add "start", "20.01.2015 01:30:15", 4
ListsDate.Add "stop", "25.01.2015 19:17:15", 4
ListsDate.Add "start", "25.01.2015 21:30:37", 4

И заданных ранее 4-х сменах

Код: Выделить всё

' I смена
TurnBegin = CDate("21.01.2015 08:00:00")
TurnEnd = CDate("21.01.2015 14:00:00")

' II смена
TurnBegin = CDate("21.01.2015 14:00:00")
TurnEnd = CDate("21.01.2015 20:00:00")

' III смена
TurnBegin = CDate("21.01.2015 20:00:00")
TurnEnd = CDate("22.01.2015 02:00:00")

' IV смена
TurnBegin = CDate("22.01.2015 02:00:00")
TurnEnd = CDate("22.01.2015 08:00:00")

Результат получается таким:

Код: Выделить всё

Смена 1
Продолжительность смены: 6 ч. 0 мин. 0 c.
          рабочее время: 6 ч. 0 мин. 0 c.
                простой: 0 ч. 0 мин. 0 c.

Смена 2
Продолжительность смены: 6 ч. 0 мин. 0 c.
          рабочее время: 6 ч. 0 мин. 0 c.
                простой: 0 ч. 0 мин. 0 c.

Смена 3
Продолжительность смены: 6 ч. 0 мин. 0 c.
          рабочее время: 6 ч. 0 мин. 0 c.
                простой: 0 ч. 0 мин. 0 c.

Смена 4
Продолжительность смены: 6 ч. 0 мин. 0 c.
          рабочее время: 6 ч. 0 мин. 0 c.
                простой: 0 ч. 0 мин. 0 c.

Если это неправильно, то как должно быть?

И ещё, почему у тебя при вызове функции tipBDLoad начала разных смен совпадают? Смены могут работать параллельно?

Код: Выделить всё

Call tipBDLoad(, "21.01.2015 08:00:00", "21.01.2015 14:00:00", " за 1 смену")
Call tipBDLoad(, "21.01.2015 08:00:00", "21.01.2015 20:00:00", " за 2 смену")
Call tipBDLoad(, "21.01.2015 08:00:00", "22.01.2015 02:00:00", " за 3 смену")
Call tipBDLoad(, "21.01.2015 08:00:00", "22.01.2015 08:00:00", " за 4 смену")


[kiber_punk]

Писал я давненько на "pure Batch" правильный алгоритм&код по вычислению затраченного времени на основе временных меток.
А там, между прочим, никаких "CDate" и иже с ним - все функции придумываем с нуля. Оно и лучше, - ибо никаких функций-чёрных ящиков и разжижения мозгов.
Не вдавался особо в коды ТС и ответивших.

Итак:

Код: Выделить всё

1) приводим временнЫе метки к НАИМЕНЬШЕМУ ОБЩЕМУ ЗНАМЕНАТЕЛЮ - в ms.
Хотябы до суток. Для абс. точности - вплоть до yeаr'ы;
2) вычисляем (t2-t1);
3) орб.маршалинг