Разница во времени Раз в четыре часа превосходит vba

Question

Это мыслитель!

У меня есть ниже набор данных:

Data http://im61.gulfup.com/AkqnzH.png

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

Table http://im45.gulfup.com/UupkLe.png

Таким образом, конечный результат должен выглядеть следующим образом: Result http://im44.gulfup.com/WNl5Z6.png

Сопроводительного сценарий кулак довольно легко:

Private Sub CommandButton21_Click() 

LastRow = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A").End(xlUp).Row 

For MyRow = 2 To LastRow 

If Format(Worksheets("Sheet1").Range("B" & MyRow).Value, "hh") = Format(Worksheets("Sheet1").Range("C" & MyRow).Value, "hh") Then 

    Set oLookin = Worksheets("Sheet2").UsedRange 
    sLookFor = Worksheets("Sheet1").Range("A" & MyRow) 
    Set oFound = oLookin.Find(What:=sLookFor, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) 

    If Not oFound Is Nothing Then 
     Worksheets("Sheet2").Cells(oFound.Row, (Format(Worksheets("Sheet1").Range("B" & MyRow).Value, "hh")) + 1).Value = _ 
     Worksheets("Sheet1").Range("C" & MyRow).Value - Worksheets("Sheet1").Range("B" & MyRow).Value 
    End If 
End If 

Next MyRow 

End Sub 

Однако, покрывая второй третий сценарий, я нахожу его сложным. Как мне заняться, если час «Времени» не совпадает с «Тайм-аутом». И затем, как мне разделить часы и остановиться в 00:00:00, так как вычитание 00:10:00 с 17:00:09 даст вам #############.

Я пытался найти решение, даже подумал об использовании модуля класса? Но не смогли понять это :(

Помощь и предложения высоко ценятся

Answer 1

Это один мыслитель! Вот еще один вариант, который выполняет своей цели, используя только VBA:

Option Explicit 

Private Sub CommandButton21_Click() 

Dim ws1   As Worksheet 
Dim ws2   As Worksheet 
Dim LastRow  As Long 
Dim MyRow  As Long 
Dim oLookin  As Range 
Dim sLookFor As String 
Dim oFound  As Range 
Dim hour1  As Long 
Dim hour2  As Long 
Dim minute1  As Long 
Dim minute2  As Long 
Dim second1  As Long 
Dim second2  As Long 
Dim curCol  As Long 
Dim curTime  As Single 

Set ws1 = Worksheets("Sheet1") 
Set ws2 = Worksheets("Sheet2") 

LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 

For MyRow = 2 To LastRow 

Set oLookin = ws2.UsedRange 
sLookFor = ws1.Range("A" & MyRow) 
Set oFound = oLookin.Find(What:=sLookFor, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) 

If Not oFound Is Nothing Then 
    curCol = Hour(ws1.Range("B" & MyRow).Value) + 2 
    hour1 = Hour(ws1.Range("B" & MyRow).Value) 
    'If the second hour is less than the first hour, then the time went past midnight, so add 24 hours to the second hour so it can be subtracted properly. 
    If Hour(ws1.Range("C" & MyRow).Value) < hour1 Then 
     hour2 = Hour(ws1.Range("C" & MyRow).Value) + 24 
    Else: hour2 = Hour(ws1.Range("C" & MyRow).Value) 
    End If 

    'If the hour of the first time value is not equal to the hour of the second time value, then loop through the hours until you get to the second hour and put in the corresponding times. 
    If hour1 <> hour2 Then 
     minute1 = Minute(ws1.Range("B" & MyRow).Value) 
     minute2 = Minute(ws1.Range("C" & MyRow).Value) 
     second1 = Second(ws1.Range("B" & MyRow).Value) 
     second2 = Second(ws1.Range("C" & MyRow).Value) 
     'Loop until the current column represents the second hour. 
     Do Until curCol = hour2 + 2 
      'This converts the minutes and seconds of the first time value to a decimal and subtracts it from 1 so you get the time that was used to the end of that hour. 
      curTime = 1 - ((minute1/60) + (second1/3600)) 
      'If the current column is equal to the first hour, use the TimeSerial and Fix functions to convert the decimal back into "h:mm:ss" format. 
      If curCol - 2 = hour1 Then 
       ws2.Cells(oFound.Row, curCol).Value = TimeSerial(Fix(curTime), Fix((curTime - Fix(curTime)) * 60), Fix((((curTime - Fix(curTime)) * 60) - Fix((curTime - Fix(curTime)) * 60)) * 60)) 
      'If the current column is not equal to the first hour, put a value of "1:00:00" into the cell. 
      Else: ws2.Cells(oFound.Row, curCol).Value = TimeSerial(1, 0, 0) 
      End If 
      'Go to the next column. 
      curCol = curCol + 1 
     Loop 
     'After you get to the second hour, get only the minutes and seconds of the second time value in decimal format. 
     curTime = (minute2/60) + (second2/3600) 
     'Use the TimeSerial and Fix functions to convert the decimal back into "h:mm:ss" format. 
     ws2.Cells(oFound.Row, curCol).Value = TimeSerial(Fix(curTime), Fix((curTime - Fix(curTime)) * 60), Fix((((curTime - Fix(curTime)) * 60) - Fix((curTime - Fix(curTime)) * 60)) * 60)) 
    'If the first hour is equal to the second hour, subtract the two time values and put the difference in the correct column. 
    Else 
     ws2.Cells(oFound.Row, curCol).Value = ws1.Range("C" & MyRow).Value - ws1.Range("B" & MyRow).Value 
    End If 
End If 

Next MyRow 

End Sub 

Обратите внимание, что, если время идет за полночь, он будет продолжать играть в те времена, после столбца Y. Это может быть изменен, чтобы сделать его остановить на колонке Если вам нужно.

Answer 2

Изменение заголовков столбцов в час начинается период затем использовать эту формулу.

=GetTime($B2,$C2,D$1) 

Copy ., что формула по всей области И SET NUMBER формат ячейки к «пользовательские» «[ч]: мм: сс»

Вот код ОДС:

Public Function GetTime(TimeIn As Date, TimeOut As Date, CurHr As Date) As Date 

Dim mins As Integer, secs As Integer 

Select Case True 
    Case Hour(TimeIn) < Hour(CurHr) And (Hour(TimeOut) > Hour(CurHr) Or Hour(TimeOut) < 1) 
     GetTime = TimeSerial(1, 0, 0) 
     Exit Function 
    Case Hour(TimeIn) = Hour(CurHr) And Hour(TimeOut) = Hour(CurHr) 
     mins = DateDiff("s", TimeIn, TimeOut) Mod 60 
     secs = DateDiff("s", TimeIn, TimeOut) - (DateDiff("s", TimeIn, TimeOut) Mod 60) * 60 
     GetTime = TimeSerial(0, mins, secs) 
    Case Hour(TimeIn) < Hour(CurHr) And Hour(TimeOut) = Hour(CurHr) 
     mins = DateDiff("s", CurHr, TimeOut) Mod 60 
     secs = DateDiff("s", CurHr, TimeOut) - (DateDiff("s", CurHr, TimeOut) Mod 60) * 60 
     GetTime = TimeSerial(0, mins, secs) 
    Case (Hour(TimeOut) > Hour(CurHr) Or Hour(TimeOut) < 1) And Hour(TimeIn) = Hour(CurHr) 
     mins = DateDiff("s", TimeIn, DateAdd("h", 1, CurHr)) Mod 60 
     secs = DateDiff("s", TimeIn, DateAdd("h", 1, CurHr)) - (DateDiff("s", TimeIn, DateAdd("h", 1, CurHr)) Mod 60) * 60 
     GetTime = TimeSerial(0, mins, secs) 
    Case Else 
     GetTime = 0 
End Select 

End Function 

Answer 3

Зачем беспокоиться о 50 строках кода VBA, когда простая формула сделает трюк?

=IF($C4>$B4,IF($B4<=D$1,IF($C4>=D$2,TIME(1,0,0),IF($C4<=D$1,"",$C4-D$1)),IF($B4>=D$2,"",IF($C4>=D$2,D$2-$B4,$C4-$B4))),IF($B4<=D$1,TIME(1,0,0),IF($B4>=D$2,"",D$2-$B4)))

Копировать формулу вниз и вправо, а формат номера изменение времени.

Обратите внимание на два вспомогательных ряда 1 и 2 с начальным и конечным временными интервалами каждого часа.В строке 3 я восстанавливал свои заголовки с этой формулой:

=TEXT(D1,"hh:mm")&"-"&TEXT(D2,"hh:mm") 

Если вам не нравится эти вспомогательные строки, вы можете, в принципе покончить с ними и извлекать значение времени из текста заголовка с помощью TIMEVALUE и SEARCH функции. Для этого замените каждый D$1 в первой формуле выше с

TIMEVALUE(LEFT(D3,SEARCH("-",D$3))) 

и каждый экземпляр D$1 с

=TIMEVALUE(MID(D3,SEARCH("-",D3)+1,50)) 

Но на мой взгляд, делать это будет немного смешно.

Обратите внимание, что эта формула не может иметь дело со временем, выходящим за столбец 23:00-00:00 на следующий день. Но его можно легко расширить, чтобы сделать это, и это остается как упражнение для читателя.