第二个excel VBA demo —— 根据规则生成加班申报数据

前言

第一个demo在这里，走过路过不要错过，嗨起来：

第一个excel VBA demo —— 添加信号并生成一段Verilog代码

第二个demo要解决快速生成加班数据的问题，具体情况在于某公司的周末加班规则如下：

1. 原则上加班时间区间8:30~24:00，每日最多上报8小时；
2. 中午休息时间为12:30~14:00，傍晚休息时间为18:00~18:30；
3. 加班申报具体原则是填写上班到岗时间和下班时间，刨除中午休息时间或晚上休息时间后为当日加班时长；
4. 每次申报刨除休息时间后要小于等于8小时，多余部分自行减除；
5. 加班时间不跨一天，即最多申请到当日24:00；

申报规则中最麻烦的是刨除休息时间时可以选择刨除中午休息时间或晚上休息时间，同时最多申报8小时，举几个例子：

1. 8:30上班，18:00下班，则填报8:30上班，18:00下班，中午休息，共计8小时；
2. 9:00上班，18:30下班，则填报9:00上班，18:30下班，中午休息，共计8小时；
3. 11:00上班，22:00下班，则填报11:00上班，17:30下班，晚上休息，共计8小时；
4. 13:00上班，21:00下班，则填报13:00上班，21:00下班，晚上休息，共计7个半小时；
5. 14:00上班，15:30下班，则填报14:00上班，15:30下班，未休息，共计1个半小时；

OK，规则就是这个，每次算应该填什么时间下班时都非常头疼，因此通过VBA做一个Excel自动生成模板。

界面

最终成型的Excel模板有两个sheet：

“加班申报界面”

“默认选项界面”

方案

为自己记录下实现过程，避免之后忘了，毕竟马上Excel就要过期了。。。

定义的公共变量

Dim myName As String
Dim myID As String
Dim myLoc As String
Dim myOffc As String
Dim myWork As String

Dim noonStart As String
Dim noonEnd As String
Dim evenStart As String
Dim evenEnd As String

Dim myDate As String
Dim myStart As String
Dim myEnd As String
Dim myRest As String

Dim realEndT As Date

Private Function get_info(need As String) As String

根据给定的need关键词，返回其后一列的单元格的值，主要用来索引如下的情况：

Private Function get_info(need As String) As String
    Cells(1, 1).Select
    Set keyCell = Cells.Find(What:=need, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Not keyCell Is Nothing Then
        get_info = ActiveSheet.Cells(keyCell.Row, keyCell.Column + 1).Value
    Else
        get_info = "???" & need
    End If
    'MsgBox get_info
End Function

Private Function get_start(need As String) As Date

获取休息起始时间；

Private Function get_start(need As String) As Date
    Cells(1, 1).Select
    Set keyCell = Cells.Find(What:=need, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Not keyCell Is Nothing Then
        get_start = CDate(ActiveSheet.Cells(keyCell.Row, keyCell.Column + 1).Value)
    Else
        get_start = CDate("12:30:00")
    End If
    'MsgBox get_start
End Function

Private Function get_end(need As String) As Date

获取休息截止时间；

Private Function get_end(need As String) As Date
    Cells(1, 1).Select
    Set keyCell = Cells.Find(What:=need, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Not keyCell Is Nothing Then
        get_end = CDate(ActiveSheet.Cells(keyCell.Row, keyCell.Column + 2).Value)
    Else
        get_end = CDate("14:00:00")
    End If
    'MsgBox get_end
End Function

Private Sub gain_glb_info()

获取全部基本信息；

Private Sub gain_glb_info()

    Dim sh As Worksheet
    Dim keyCell As Range
    
    For Each sh In Worksheets
        If sh.Name = "默认选项配置" Then
            Sheets(sh.Name).Select
            Exit For
        End If
    Next
    
    'MsgBox ActiveSheet.Name
    
    myName = get_info("姓名")
    myID = get_info("ID")
    myLoc = get_info("办公地点")
    myOffc = get_info("所属部门")
    myWork = get_info("加班事宜")
    noonStart = get_start("午饭时间")
    noonEnd = get_end("午饭时间")
    evenStart = get_start("晚饭时间")
    evenEnd = get_end("晚饭时间")
    
End Sub

Private Function gain_work_info() As Boolean

通过弹窗获取上下班真实打卡时间；

Private Function gain_work_info() As Boolean
    gain_work_info = False
    
    myDate = InputBox(prompt:="加班日期", Title:="信息获取", Default:=Date)
    If myDate = "" Then
        myDate = False
        Exit Function
    End If
    
    myStart = InputBox(prompt:="打卡开始(8:30~23:59)", Title:="信息获取", Default:="8:30")
    If myStart = "" Then
        myStart = False
        Exit Function
    End If
    
    myEnd = InputBox(prompt:="打卡结束(8:30~23:59)", Title:="信息获取", Default:="18:00")
    If myEnd = "" Then
        myEnd = False
        Exit Function
    End If
    gain_work_info = True
    
End Function

Private Sub cal_work_time()

计算应该填报的下班时间，这个地方是我最头疼的，所以最后选择的方式是：

上班时间直接+8个小时+傍晚0.5小时，是不是比6:30晚，如果是则选择扣除晚饭时间；否则扣除午饭时间；

上面算出来的时间（上班时间直接+8个小时+傍晚0.5小时）再和实际打下班卡时间比较，选择比较晚的那个；

Private Sub cal_work_time()

    Dim myStartT As Date
    Dim noonGrap As Date
    Dim evenGrap As Date
    Dim noonFlag As Integer
    
    noonGrap = Format(CDate(noonEnd) - CDate(noonStart), "hh:mm")
    evenGrap = Format(CDate(evenEnd) - CDate(evenStart), "hh:mm")
    
    myStartT = Format(CDate(myStart), "hh:mm")
    If Format(myStart, "hh:mm") >= CDate("15:30") Then
        realEndT = CDate(myEnd)
    ElseIf Format(myStart + CDate("8:00:00") + evenGrap, "hh:mm") >= CDate(evenEnd) Then '扣除晚上时间
        realEndT = Format(myStart + CDate("8:00:00") + evenGrap, "hh:mm")
    Else '扣除中午时间
        realEndT = Format(myStart + CDate("8:00:00") + noonGrap, "hh:mm")
        noonFlag = 1
    End If
    

    If realEndT > CDate(myEnd) Then
        realEndT = Format(CDate(myEnd), "hh:mm")
    End If
    
    If Format(myStart, "hh:mm") <= CDate(evenStart) And Format(realEndT, "hh:mm") >= CDate(evenEnd) And noonFlag <> 1 Then
        myRest = Format(evenStart, "hh:mm") & "~" & Format(evenEnd, "hh:mm")
    ElseIf Format(myStart, "hh:mm") <= CDate(noonStart) And Format(realEndT, "hh:mm") >= CDate(noonEnd) Then
        myRest = Format(noonStart, "hh:mm") & "~" & Format(noonEnd, "hh:mm")
    Else
        myRest = "无午休时间"
    End If
    
    'MsgBox realEndT
    
End Sub

不过这里我总感觉有点漏洞，可能正常用还行，如果试错的可能有Corner点；

Private Function gainLastRow() As Integer

获取当前sheet可用的最后一行的行号；

Private Function gainLastRow() As Integer

    Dim lastRow As Integer
    
    lastRow = ActiveSheet.UsedRange.Rows.Count
    gainLastRow = ActiveSheet.UsedRange.Rows(lastRow).Row + 1
    'Debug.Print gainLastRow
    
End Function

Public Sub mainAddSig()

将各项添加到申报表中，每添加一次会询问是否继续添加；

Public Sub mainAddSig()
    
    Dim addRow As Integer
    Dim sh As Worksheet
    
    For Each sh In Worksheets
        If sh.Name = "加班申报界面" Then
            Sheets(sh.Name).Select
            Exit For
        End If
    Next
    
    Do
        If gain_work_info() = True Then
            'Debug.Print "@@@@@@@"
            Call cal_work_time
            addRow = gainLastRow()
            With ActiveSheet
                .Cells(addRow, 1).Value = myName
                .Cells(addRow, 2).Value = myID
                .Cells(addRow, 3).Value = myLoc
                .Cells(addRow, 4).Value = myOffc
                .Cells(addRow, 5).Value = myDate
                .Cells(addRow, 6).Value = myStart
                .Cells(addRow, 7).Value = Format(realEndT, "hh:mm")
                .Cells(addRow, 8).Value = myRest
                .Cells(addRow, 9).Value = myWork
            End With
        Else
            Exit Sub
        End If
    Loop Until MsgBox("是否继续添加?", vbOKCancel) <> vbOK
    
End Sub

Public Sub mian()

主函数，分为两部分：获取配置信息和循环添加；

Public Sub mian()
    Call gain_glb_info
    Call mainAddSig
End Sub

成果

添加按钮后点击按钮，一次询问加班日期和上下班时间：

最后的结果：

嗯，看着还行，再填一个：

OK，收工~~~给自己点个赞吧~~~