-4

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

我觉得这应该不是太难。我尝试使用一些条件公式来计算和分解 OT，但无法提出任何适用于所有情况并允许流程自动化的方法。我在下面提供了一个指向时钟生成的示例电子表格的链接。是否可以在不使用 VBA 的情况下以我想要的方式打破 OT？

示例电子表格

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

4

2 回答 2

0

今天早上我需要一些大脑挑战，所以我决定帮助你。我就是这样解决你的问题的。

打开开发者标签

打开 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

注意：您需要打开Properties Window，单击菜单栏上的View然后选择Properties Window或点击F4

在此处输入图像描述

选择Class Module并将其从Class1重命名为Merged

在此处输入图像描述

返回电子表格视图并选择时间详细信息表

点击ALT+F8

在此处输入图像描述

或者

在开发人员选项卡上选择宏并点击Run

结果OVERTIME将填写到您的时间详细信息表列G

还

将添加一个名为的新工作表Overtime Only，其中包含所有加班人员的表格。（并且只有那些获得加班费的人）

结果看起来像

Time Detail

在此处输入图像描述

Overtime Only

在此处输入图像描述

于 2013-10-11T09:36:08.333 回答
0

我从@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
于 2013-10-11T23:37:20.663 回答