以小时间隔划分的时差excel vba

这是一个思想家

我有以下数据集：

我的目标是获得时差并将其划分为小时间隔。i、 e.每个人每小时花费的时间如下：

所以最终结果应该是这样的：

覆盖第一个场景非常简单：

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停止，因为从17:00:09减去00:10:00会得到

我一直在试图找出一个解决方案，甚至想过以某种方式使用类模块？但我还没弄明白：(

---

非常感谢您的帮助和建议。

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

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

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

在所有区域复制该公式。并将单元格的数字格式设置为“custom”“[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

公共函数GetTime（TimeIn作为日期、TimeOut作为日期、CurHr作为日期）作为日期
分钟为整数，秒为整数
选择Case True
案例小时（TimeIn）Hour（CurHr）或Hour（TimeOut）<1）
GetTime=TimeSerial（1,0,0）
退出功能
案例小时数（TimeIn）=小时数（CurHr）和小时数（TimeOut）=小时数（CurHr）
mins=DateDiff（“s”，TimeIn，TimeOut）Mod 60
secs=DateDiff（“s”，TimeIn，TimeOut）-（DateDiff（“s”，TimeIn，TimeOut）Mod 60）*60
GetTime=时间序列（0，分，秒）
案例小时（TimeIn）<小时（CurHr）和小时（超时）=小时（CurHr）
分钟=日期差（“s”，电流，超时）Mod 60
secs=DateDiff（“s”，CurHr，TimeOut）-（DateDiff（“s”，CurHr，TimeOut）Mod 60）*60
GetTime=时间序列（0，分，秒）
案例（小时（超时）>小时（CurHr）或小时（超时）<1）和小时（TimeIn）=小时（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=时间序列（0，分，秒）
其他情况
GetTime=0
结束选择
端函数

---

那个人是一个思想者！这里有另一个选项，可以仅使用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

选项显式
私有子命令按钮21_单击（）
将ws1设置为工作表
将ws2设置为工作表
最后一排一样长
让我的行变长
Dim-oLookin As系列
昏暗的斯洛卡绳
深度范围
暗淡的小时1一样长
昏暗的一个小时有多长
暗淡的一分钟1倍长
昏暗的一分钟2倍长
第二个1一样长
第二条同样长
长得一样暗
像单身一样黯淡
设置ws1=工作表（“表1”）
设置ws2=工作表（“表2”）
LastRow=ws1.Cells（ws1.Rows.Count，“A”）.End（xlUp）.Row
对于MyRow=2到LastRow
设置oLookin=ws2.UsedRange
sLookFor=ws1.Range（“A”和MyRow）
查找（What:=sLookFor，LookIn:=xlValues，LookAt:=xlPart，MatchCase:=False）
如果不是的话，那就什么都不是了
curCol=Hour（ws1.Range（“B”和MyRow）.值）+2
hour1=小时（ws1.Range（“B”和MyRow）.Value）
“如果第二个小时比第一个小时短，那么时间就过了午夜，所以在第二个小时加上24小时，这样就可以适当地减去它。
如果小时（ws1.Range（“C”&MyRow.Value）

---

请注意，如果时间超过午夜，它将继续填充Y列之后的时间。如果需要，可以修改此项以使其停止在Y列。

当一个简单的公式需要时，为什么还要麻烦使用50行VBA代码

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

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