VBA_加班

Sub 第一步_整理数据删除()
    Excel.Application.DisplayAlerts = False
    ' 自动删除第四行
    Rows(4).Select
    Selection.EntireRow.Delete
    '变量wb代表一个工作表，将这个变量声明；
    Dim wb As Workbook
    '将打开的表赋值给wb这个变量
    Set wb = Workbooks.Open("c:\data\钉钉-加班.xlsx")
    For L = Sheets(1).Range("a65536").End(xlUp).Row To 1 Step -1
        If Range("C" & L) = "已撤销" Then
            Range("C" & L).Select
            Selection.EntireRow.Delete
        End If
        
        If Range("D" & L) = "拒绝" Then
            Range("D" & L).Select
            Selection.EntireRow.Delete
        End If
    Next
    '将当前活动表格当中不需要的列全部删除；
    Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,I:I,K:K").Select
    Range("K1").Activate
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,I:I,K:K,L:L,M:M,N:N").Select
    Range("N1").Activate
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,I:I,K:K,L:L,M:M,N:N,O:O,R:R,S:S,T:T").Select
    Range("T1").Activate
    ActiveWindow.ScrollColumn = 14
    Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,I:I,K:K,L:L,M:M,N:N,O:O,R:R,S:S,T:T,V:V,W:W" _
            ).Select
    Range("W1").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWorkbook.Save
    '关闭表格
    wb.Close
    ' 恢复提醒
    Excel.Application.DisplayAlerts = True
    ' 复制表格到当前工作薄
    Set wb = Workbooks.Open("c:\data\钉钉-加班.xlsx")
    wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    
    MsgBox "已经将包含撤销和拒绝的行删除，并整理好数据复制到当前表格，请继续执行下一步"
End Sub



Sub 第二步_取值()
    Dim a As Integer
    For i = 2 To Range("a65535").End(xlUp).Row
        
        Sheets(1).Range("a" & i + 2) = Sheets(2).Range("a" & i)
        Sheets(1).Range("b" & i + 2) = Sheets(2).Range("b" & i)
        Sheets(1).Range("d" & i + 2) = Sheets(2).Range("c" & i)
        Sheets(1).Range("e" & i + 2) = Sheets(2).Range("d" & i)
        Sheets(1).Range("f" & i + 2) = Sheets(2).Range("e" & i)
        
    Next
    MsgBox "已经到到想要的数据，请继续执行第三步"
End Sub

Sub 加班_第三步自动展开并删除辅助数据()
    For i = 4 To Range("a65536").End(xlUp).Row
        k = DateValue(Range("e" & i)) - DateValue(Range("d" & i))
        If k > 1 Then
            Rows(i).Select
            With Selection.Interior
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next
    
    Sheets(1).Select

    Dim strStart, strEnd
    
    k = 2000
    For i = 4 To Range("a65535").End(xlUp).Row
        For j = 1 To DateValue(Range("e" & i)) - DateValue(Range("d" & i)) + 1
            If j = 1 Then
                strStart = Split(Range("d" & i), " ")(1)
            Else
                strStart = "08:30"
            End If
            
            If j = DateValue(Range("e" & i)) - DateValue(Range("d" & i)) + 1 Then
                strEnd = Split(Range("e" & i), " ")(1)
            Else
                strEnd = "17:30"
            End If
            Range("a" & i & ":c" & i).Copy Range("a" & k)
            Range("f" & i).Copy Range("f" & k)
            Range("d" & k) = Format(DateValue(Range("d" & i)) + j - 1, "yyyy-mm-dd ") & strStart
            Range("e" & k) = Format(DateValue(Range("d" & i)) + j - 1, "yyyy-mm-dd ") & strEnd
            k = k + 1
        Next
    Next
    Excel.Application.DisplayAlerts = False
    Rows("4:1999").Select
    Selection.Delete Shift:=xlUp
    Excel.Application.DisplayAlerts = True
    MsgBox "已经将跨天的数据展开，请重点关注标黄的行的加班小时数！！！"
End Sub

Sub 第四步_取年月日并删除辅助数据()
    Sheets(1).Select
    On Error Resume Next
    For i = 4 To Sheet1.Range("a65536").End(xlUp).Row
        Sheet1.Range("c" & i) = Split(Sheet1.Range("d" & i), " ")(0)
        Sheet1.Range("I" & i) = "加班费"
    Next
    
    Excel.Application.DisplayAlerts = False
    Sheets(2).Delete
    Excel.Application.DisplayAlerts = True
    
    
    MsgBox "第三列取到第四列的年月日，补偿方式统一为加班费，并删除第了辅助数据，至此，加班单已经处理完毕了，请别忘记处理加班类型！！！！！！"
End Sub