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
    
    
    Set te = wb.Worksheets(1)
    te.Columns("R").Delete Shift:=xlToLeft
    
    Set te = wb.Worksheets(1)
    te.Columns("O:K").Delete Shift:=xlToLeft
    
    Set te = wb.Worksheets(1)
    te.Columns("A:G").Delete Shift:=xlToLeft

    Set te = wb.Worksheets(1)
    te.Columns("B").Delete Shift:=xlToLeft
    
      '保存表格，如果没有这一步的话，前面的操作不会保存；
    ActiveWorkbook.Save
    '关闭表格
    wb.Close
    ' 恢复提醒
    Excel.Application.DisplayAlerts = True
    
        MsgBox "删除了无用的行列，请继续执行第二步"
End Sub

Sub 第二步_复制整理好数据()
Dim str As String
'将上述处理好的表格复制到当前工作薄里面，在这里面会当做是sheet2
    Set wb = Workbooks.Open("c:data钉钉-补卡.xlsx")
    wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    wb.Close
    MsgBox "请继续执行第三步"
End Sub

Sub 第三步_取值()
For i = 2 To Sheets(2).Range("a65536").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("c" & i + 2) = Split(Sheets(2).Range("c" & i), " ")(0)
    Sheets(1).Range("d" & i + 2) = Split(Sheets(2).Range("c" & i), " ")(1)
    Sheets(1).Range("e" & i + 2) = Sheets(2).Range("d" & i)
    
Next
    Excel.Application.DisplayAlerts = False
    Sheets(2).Delete
    Excel.Application.DisplayAlerts = True
    
    
    Columns("C:C").Select
    Selection.Replace What:="(已离职)", Replacement:="", LookAt:=xlPart, _
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
   For i = 4 To Sheet1.Range("a65536").End(xlUp).Row
    Sheet1.Range("E" & i) = "忘记打卡"
   Next
   
    t = Sheet1.Range("a65536").End(xlUp).Row
        Range("D4:D" & t).Select
    Selection.NumberFormatLocal = "hh:mm"
    Selection.TextToColumns Destination:=Range("D4"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
     
     
 q = Sheets(1).Range("a65536").End(xlUp).Row
 For i = 4 To q
    k = Len(Range("a" & i).Value)
    If k > 10 Then
    Rows(i).Select
        With Selection.Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
Next
    MsgBox "所有已离职替换为空，原因全部更改成忘记打卡，补卡表已经处理完成了，标黄的行意为工号异常"
End Sub