第二個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，收工~~~給自己點個贊吧~~~