時差以小時為間隔分割excel vba

Question

這個是思想家！

我有以下數據集：

數據http://im61.gulfup.com/AkqnzH.png

我的目標是獲得時差並將其分成小時間隔。 即每個人每小時花費的時間如下：

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

所以最終結果應如下所示： 結果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

然而，覆蓋第二個第三個場景是我發現它具有挑戰性的地方。 如果“Time In”小時與“Time Out”不同，我該怎么辦？ 然后如何分割小時並在00:00:00停止，因為從17:00:09減去00:10:00會給你#############。

我一直試圖找出一個解決方案，甚至想到以某種方式使用類模塊？ 但一直無法弄清楚:(

幫助和建議非常感謝。

Answer 1

當一個簡單的公式可以解決這個問題時，為什么要用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列的次數，即第二天。 但它可以很容易地擴展到這樣做，這留給讀者練習。

Answer 2

將列標題更改為期間開始的小時，然后使用此公式：

=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

Answer 3

那個人是思想家！ 這是另一個僅使用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列。