расчет отработанного времени

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

pashulka
Сообщения: 831
Зарегистрирован: 24 ноя 2004, 03:46
Контактная информация:

07 апр 2011, 14:34

Чисто телепатически, а также основываясь на посте#11, предположу, что в исходных ячейках у Вас не дата, а текст - 01.04.2011. 11:30 (ибо третьей точки там быть не должно), а в этом случае, можно либо преобразовать текст именно в дату, либо вместо C2, D2 использовать одну из нижеопубликованных формул :

=ПОДСТАВИТЬ(C2;".";;3)
=ЗАМЕНИТЬ(C2;11;1 ;)

P.S. Любая из вышеприведённых формул, возвращает текст, однако, это не помешает вычитанию, впрочем, если Вы принципиальный противник подобных действий, то :

=ЗНАЧЕН(ПОДСТАВИТЬ(C2;".";;3))
=ПОДСТАВИТЬ(C2;".";;3)*1
=ПОДСТАВИТЬ(C2;".";;3)+0
=--ПОДСТАВИТЬ(C2;".";;3)
pashulka
Сообщения: 831
Зарегистрирован: 24 ноя 2004, 03:46
Контактная информация:

07 апр 2011, 14:40

Часы (без учёта минут и секунд) * 7,46 можно, например, так :

=ЦЕЛОЕ(A1-A2)*7,46
=ОТБР(A1-A2)*7,46
legioneer777
Сообщения: 1
Зарегистрирован: 06 фев 2017, 21:30

14 фев 2017, 21:39

Avsha писал(а):Вот такой вариант подготовил,
тщательно не тестировал, но вроде работает...

в виде пользовательской функции, судя по алгоритму
на формулах будет сложновато реализовать ;)

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

Public Function Len_DateTime(dt1 As Date, dt2 As Date, Min0_Hour1_Day2 As Integer)
Application.Volatile True

Dim i As Long
Dim S As Double
Dim Report_Str As String
Dim StartWorkDay As Date, EndWorkDay As Date
    StartWorkDay = "09:00:00"
    EndWorkDay = "18:00:00"

'Проверка на достоверность исходных данных
'-------------------------------------------------------------
If dt1 > dt2 Then Len_DateTime = 0: Exit Function


'Приведение начала и конца диапазона к границам рабочего дня
'-------------------------------------------------------------
If TimeValue(dt1) < StartWorkDay Then
                                    dt1 = DateValue(dt1) + TimeValue(StartWorkDay)
                                 Else
If TimeValue(dt1) > EndWorkDay Then dt1 = DateValue(dt1) + TimeValue(EndWorkDay)
End If


If TimeValue(dt2) < StartWorkDay Then
                                    dt2 = DateValue(dt2) + TimeValue(StartWorkDay)
                                 Else
If TimeValue(dt2) > EndWorkDay Then dt2 = DateValue(dt2) + TimeValue(EndWorkDay)
End If


'Начало и конец временного диапазона относятся к одному дню
'-------------------------------------------------------------
If Int(dt1) = Int(dt2) Then

If Weekday(dt1, vbMonday) <> 6 And Weekday(dt1, vbMonday) <> 7 Then
    S = S + (TimeValue(dt2) - TimeValue(dt1))
    'в отчет
    Report_Str = Report_Str & DateValue(dt1) & " / " _
                    & Weekday(dt1, vbMonday) & " / " _
                    & Format(TimeValue(dt2) - TimeValue(dt1), "hh:mm:ss") _
                    & " " & Chr(13)
End If
        GoTo End_work
End If


'Начало и конец временного диапазона относятся к разным дням
'-------------------------------------------------------------
' Обработка дня - начала временного диапазона
If Weekday(dt1, vbMonday) <> 6 And Weekday(dt1, vbMonday) <> 7 Then
    S = S + (EndWorkDay - TimeValue(dt1))
    'в отчет
    Report_Str = Report_Str & DateValue(dt1) & " / " _
                    & Weekday(dt1, vbMonday) & " / " _
                    & Format(EndWorkDay - TimeValue(dt1), "hh:mm:ss") _
                    & " " & Chr(13)
End If

' Обработка дней - между началом и концом временного диапазона
For i = Int(CDbl(dt1)) + 1 To Int(CDbl(dt2)) - 1

If Weekday(CDate(i), vbMonday) <> 6 And _
   Weekday(CDate(i), vbMonday) <> 7 Then
      S = S + (EndWorkDay - StartWorkDay)
      'в отчет
      Report_Str = Report_Str & CDate(i) & " / " _
                    & Weekday(CDate(i), vbMonday) & " / " _
                    & Format(EndWorkDay - StartWorkDay, "hh:mm:ss") _
                    & " " & Chr(13)
End If
Next i

' Обработка дня - конца временного диапазона
If Weekday(dt2, vbMonday) <> 6 And Weekday(dt2, vbMonday) <> 7 Then
    S = S + (TimeValue(dt2) - StartWorkDay)
    'в отчет
    Report_Str = Report_Str & DateValue(dt2) & " / " _
                    & Weekday(dt2, vbMonday) & " / " _
                    & Format(TimeValue(dt2) - StartWorkDay, "hh:mm:ss") _
                    & " " & Chr(13)
End If



End_work:
    
    Select Case Min0_Hour1_Day2
    Case 0
        Len_DateTime = S * 24 * 60
    Case 1
        Len_DateTime = S * 24
    Case 2
        Len_DateTime = S
    Case Else
        Len_DateTime = Report_Str
    End Select
    
    'вывод отчета
    'MsgBox Report_Str
    
End Function
Спасибо помог с функцией!

Может кому понадобится)
Немного допилил функцию добавив возможность указания для пятницы отдельного графика работы, указания обеденного времени, и списка праздничных дней.

С vba работаю недавно, поэтому может не очень и производительно получилось,но считает верно.
У вас нет необходимых прав для просмотра вложений в этом сообщении.
unjusia
Сообщения: 0
Зарегистрирован: 11 апр 2017, 14:59

18 апр 2017, 06:46

все ок!всем нравится,и мне!

http://3-an.ru - кондиционеры и вентиляция
Ответить