Vba 根据表格计算每日和每周加班时间

我正试图建立一个Excel 2010电子表格，根据时钟生成的电子表格计算员工加班时间。时钟的报告仅给出总小时数。加班时间可以通过将工时分为正常工时和加班工时来计算。一天中任何超过10小时的都算作加班时间。一旦您达到40个正常工作小时（不包括加班），超过该点的所有小时都将被计算为加班。然后将所有OT相加。如果您从未达到40个正常工作小时，但仍有每日加班，则使用每日加班

我觉得这应该不会太难。我曾尝试使用一些条件公式来计算和分解OT，但未能找到任何在所有情况下都有效并允许流程自动化的方法。我在下面添加了一个链接，链接到由时钟生成的示例电子表格。如果不使用VBA，是否可以按照我想要的方式进行OT

---

如果您需要任何其他信息，请告诉我。至少一些关于从哪里开始的想法是非常受欢迎的，或者如果有其他帖子可以解决类似的问题，我可以用它来开始，我还没有找到任何在这种情况下很有效的帖子。谢谢

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

打开Visual Basic编辑器ALT+F11或

插入一个标准模块

将下面的代码复制并粘贴到该模块中

将类模块重命名为“合并”

注意：您需要打开“属性”窗口，或者单击菜单栏上的“视图”，然后选择“属性窗口”，或者单击F4

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

返回电子表格视图并选择时间明细表

按ALT+F8键

或

在“开发人员”选项卡上选择“宏”，然后单击“运行”

加班结果将填入您的时间明细表G列

也

将添加一个名为“仅加班”的新表，该表将列出所有加班的人员。只有那些加班的人

结果将是

时间细节

只加班

---

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

我创建了一个额外的类模块DlyHrs，它为一名员工保存一天的小时数。每个人都有这些DlyHrs对象的集合，因此可以跟踪他们一周的总常规和加班时间

类模块DlyHrs-

Option Explicit

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

我修改了类模块，如下所示-

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

---

询问代码的问题必须证明对正在解决的问题的最低理解。包括尝试过的解决方案、它们不起作用的原因以及预期结果。另请参见：我不一定要求代码。但我不确定如果没有VBA是否可以解决这个问题。我会尝试抛出一些VBA在它，并将张贴什么，我能想出一个起点。谢谢，这是伟大的！唯一的问题是，它没有考虑工作超过40小时的员工每周的加班时间。我将您的代码作为起点，并将其修改为考虑每周加班。我会把它贴在下面。但是现在加班时间列在加班时间列中，你可以添加另一个带有周数的列，并将其显示在透视表中。嗯，是的。如果你看我的代码，它仍然把加班时间放在一个单独的加班时间列中，就像你的代码一样。我只是修改了循环，这样当它每天计算加班时，它也会记录每个人的总小时数，所以当他们达到40小时时，它会将所有的小时数放入加班列中。我还修改了它，在第一个循环的同时将加班时间复制到加班列中，因为它正在计算加班时间，而不是像代码中那样在不同的循环中分离这一部分。

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