时差以小时为间隔分割excel vba

时间:2015-01-16 20:32:41

标签: excel vba excel-vba

这是思想家!

我有以下数据集:

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

然而,第二个第三个场景是我发现它具有挑战性的地方。如果“Time In”小时与“Time Out”不同,我该怎么办?然后如何分割小时并在00:00:00停止,因为从17:00:09减去00:10:00会给你#############。

我一直试图找出一个解决方案,甚至想到以某种方式使用类模块?但一直无法弄明白:(

非常感谢帮助和建议。

3 个答案:

答案 0 :(得分:2)

当一个简单的公式可以解决问题时,为什么还要使用50行VBA代码呢?

enter image description here

=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")

如果您不喜欢这些帮助行,您原则上可以取消它们,并使用TIMEVALUESEARCH函数从标题文本中提取时间值。为此,请使用

替换上面第一个公式中的D$1的每个实例
TIMEVALUE(LEFT(D3,SEARCH("-",D$3)))

以及D$1的每个实例

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

但在我看来,这样做有点荒谬。

请注意,此公式无法处理23:00-00:00列以外的时间,即第二天。但它可以很容易地扩展到这样做,这留给读者练习。

答案 1 :(得分:1)

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

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

将该公式复制到所有区域。 并将“CELL”的数字格式设置为“自定义”“[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

enter image description here

答案 2 :(得分: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列之后的时间。如果需要,可以修改它以使其停在Y列。