从表中计算每日和每周加班

Question

我正在尝试设置Excel（2010）电子表格，以便根据时钟生成的电子表格计算员工的加班费。来自时钟的报告仅提供总小时数。加班可以通过将小时分为常规小时和加班时间来计算。一天超过10小时的任何事情都算作加班时间。一旦达到40个常规时间（不包括OT），超过该点的所有小时数都计为OT。然后将所有OT加起来。如果你从未达到40个正常时间，但仍然每天都有OT，那么就会使用每日OT。

我觉得这不应该太难了。我已经尝试使用一些条件公式来计算和分解OT，但是还没有能够提出任何适用于所有情况的东西并允许该过程自动化。我在下面的链接中添加了一个由时钟生成的示例电子表格。是否有可能在不使用VBA的情况下以我想要的方式突破OT？

Example Spreadsheet

如果您需要任何其他信息，请与我们联系。至少有一些关于从哪里开始的想法将是非常受欢迎的，或者如果有其他帖子解决类似问题我可以用来开始（我在这种情况下找不到任何相当的工作）。谢谢！

Answer 1

今天早上我需要一点脑力挑战，所以我决定帮助你。这就是我解决你问题的方法。

Turn on developer tab

打开Visual Basic编辑器 ALT + F11 或

插入一个标准模块

将以下代码复制并粘贴到模块

中

Option Explicit

Sub OTHours()

    Sheets(2).Activate
    Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row).ClearContents

    Dim c As Collection
    Set c = New Collection

    Dim e As Collection
    Set e = New Collection

    On Error GoTo RowHandler

    Dim i As Long, r As Range
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set r = Range("C" & i)
        c.Add r.Row, r.Offset(0, -2) & "£" & r
    Next i

    For i = 1 To c.Count
        If i <> c.Count Then
            Dim j As Long
            j = c.Item(i)

            Dim m As Merged
            Set m = New Merged

            m.Name = Range("A" & c.Item(i))
            m.Dates = Range("C" & c.Item(i))

            Do Until j = c.Item(i + 1)
                m.Hours = m.Hours + Range("F" & j)
                m.Row = j
                j = j + 1
            Loop
        Else
            Dim k As Long
            k = c.Item(i)

            Set m = New Merged

            m.Name = Range("A" & c.Item(i))
            m.Dates = Range("C" & c.Item(i))

            Do Until IsEmpty(Range("A" & k))
                m.Hours = m.Hours + Range("F" & k)
                m.Row = k
                k = k + 1
            Loop
        End If
        e.Add m
    Next i

    For i = 1 To e.Count
        'Debug.Print e.Item(i).Name, e.Item(i).Dates, e.Item(i).Hours, e.Item(i).Row
        Range("G" & e.Item(i).Row) = IIf(e.Item(i).Hours - 10 > 0, e.Item(i).Hours - 10, vbNullString)
    Next i

    PrintOvertime e

    Exit Sub

RowHandler:
    Resume Next
End Sub


Private Sub PrintOvertime(e As Collection)
    Application.DisplayAlerts = False
    Dim ws As Worksheet
    For Each ws In Sheets
        If StrComp(ws.Name, "Overtime Only", vbTextCompare) = 0 Then ws.Delete
    Next
    Application.DisplayAlerts = True
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Overtime Only"
    Set ws = Sheets("Overtime Only")
    With ws
        Dim i As Long
        .Range("A1") = "Applicant Name"
        .Range("B1") = "Date"
        .Range("C1") = "OT hours"
        .Range("D1") = "Week Number"
        For i = 1 To e.Count
            If (e.Item(i).Hours - 10 > 0) Then
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1) = e.Item(i).Name
                .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1) = e.Item(i).Dates
                .Range("C" & .Range("C" & Rows.Count).End(xlUp).Row + 1) = e.Item(i).Hours - 10
            End If
        Next i
        .Columns.AutoFit
    End With

    PrintWeekNum
End Sub

Private Sub PrintWeekNum()
    Dim ws As Worksheet
    Set ws = Sheets("Overtime Only")
    With ws
        Dim i As Long
        For i = 2 To .Range("C" & Rows.Count).End(xlUp).Row
            Dim r As String
            r = .Range("B" & i).Text
            .Range("D" & i) = WorksheetFunction.WeekNum(Right(r, 4) & "-" & Left(r, 2) & "-" & Right(Left(r, 5), 2))
        Next i
    End With
End Sub

现在插入类模块

将以下代码复制并粘贴到其中

Option Explicit

Public Name As String
Public Dates As Date
Public Hours As Double
Public Row As Long

将课程模块重命名为Merged

注意：您需要打开属性窗口，单击菜单栏上的查看，然后选择属性窗口或点击 F4

选择类模块并将其从 Class1 重命名为 Merged

---

返回电子表格视图，然后选择时间明细表

点击 ALT + F8

或

在“开发者”标签上选择宏，然后点击运行

---

OVERTIME 结果将填入您的时间详情工作表列G

另外

将添加一个名为 Overtime Only 的新工作表，其中包含所有额外工作时间的人员表。 （只有那些赢得加班费的人）

结果将如下所示

<强> Time Detail

<强> Overtime Only

Answer 2

我从@mehow那里得到了答案并对其进行了一些修改，以便将每周加班时间考虑在内。我不确定这是否是最干净或最有效的方法，但它可以完成任务。

我创建了一个额外的课程模块“DlyHrs”，它可以为单个员工提供一天的课程。每个人都有这些DlyHrs对象的集合，因此可以跟踪他们一周的常规和OT时间。

课程单元“DlyHrs” -

Option Explicit

Public Day As Date
Public totHrs As Double
Public regHrs As Double
Public otHrs As Double
Public row As Long

我将类模块“Merged”修改为 -

Option Explicit

Public Name As String
Public Hrs As Collection
Public regHrs As Double
Public otHrs As Double
Public totHrs As Double

到目前为止，它似乎正在发挥作用，正确地突破了所有每日和每周加班。这是宏的整个代码 -

Option Explicit

Sub OTHours()

ThisWorkbook.Sheets("Time Detail").Activate
Range("T2:T" & Range("T" & Rows.Count).End(xlUp).row).ClearContents
Range("T1") = "OT"

Dim c As Collection
Set c = New Collection
Dim e As Collection
Set e = New Collection

On Error GoTo RowHandler

Dim i As Long, r As Range
For i = 2 To Range("A" & Rows.Count).End(xlUp).row
    Set r = Range("H" & i)
    c.Add r.row, r.Offset(0, -7) & "£" & r
Next i

'store name of previous person to know when to add new person to collection
Dim prev As String
prev = vbNullString

For i = 1 To c.Count
    Dim j As Long
    j = c.Item(i)
    Dim curr As String
    curr = Range("A" & j)

    'if not dealing with a new person, add hours to existing person
    'rather than creating new person
    If curr = prev Then GoTo CurrentPerson
        Dim m As Merged
        Set m = New Merged
        m.Name = Range("A" & c.Item(i))
        Set m.Hrs = New Collection

    CurrentPerson:
        Dim curHrs As DlyHrs
        Set curHrs = New DlyHrs
        curHrs.Day = Range("H" & c.Item(i))

        If i <> c.Count Then
            'Add up hours column
            Do Until j = c.Item(i + 1)
                curHrs.totHrs = curHrs.totHrs + Range("K" & j)
                curHrs.row = j
                j = j + 1
            Loop
        Else
            Do Until IsEmpty(Range("A" & j))
                curHrs.totHrs = curHrs.totHrs + Range("K" & j)
                curHrs.row = j
                j = j + 1
            Loop
        End If

        'break out regular and OT hours and add to current person
        If m.regHrs = 40 Then 'all hrs to OT
            curHrs.otHrs = curHrs.totHrs
            m.totHrs = m.totHrs + curHrs.totHrs
            m.otHrs = m.otHrs + curHrs.totHrs
        ElseIf m.regHrs + curHrs.totHrs > 40 Then 'approaching 40
            curHrs.regHrs = 40 - m.regHrs
            curHrs.otHrs = curHrs.totHrs - curHrs.regHrs
            m.totHrs = m.totHrs + curHrs.totHrs
            m.regHrs = m.regHrs + curHrs.regHrs
            m.otHrs = m.otHrs + curHrs.otHrs
        ElseIf curHrs.totHrs > 10 Then 'not approaching 40, but daily ot
            curHrs.otHrs = curHrs.totHrs - 10
            curHrs.regHrs = curHrs.totHrs - curHrs.otHrs
            m.totHrs = m.totHrs + curHrs.totHrs
            m.regHrs = m.regHrs + curHrs.regHrs
            m.otHrs = m.otHrs + curHrs.otHrs
        Else 'no daily or weekly ot
            m.totHrs = m.totHrs + curHrs.totHrs
            m.regHrs = m.regHrs + curHrs.totHrs
        End If

        If curHrs.otHrs <> 0 Then
            Range("T" & curHrs.row) = curHrs.otHrs
        End If
        m.Hrs.Add curHrs

        Dim nextPerson As String
        nextPerson = Range("A" & j)

        'check if next name is a new person. if so, add current person to collection
        If curr <> nextPerson Then
            e.Add m
        End If
        prev = curr
Next i

Exit Sub

RowHandler:
Resume Next
End Sub