首页 > 编程语言 > 详细

VBA_打卡

时间:2021-03-29 17:51:35      阅读:38      评论:0      收藏:0      [点我收藏+]

VBA_打卡

需求

代码

Sub 第一步_请假_删除周末两天以及删除无用的行和列()
    Excel.Application.DisplayAlerts = False
    ‘变量wb代表一个工作表,将这个变量声明;
    Dim wb As Workbook
    ‘将打开的表赋值给wb这个变量
    Set wb = Workbooks.Open("c:\data\钉钉_打卡.xlsx")
    

    Cells.Replace What:="星期*", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Sheets(1).Select
    For i = 5 To Range("a65536").End(xlUp).Row
     If Range("K" & i) Like "次*" Then
                Rows(i).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                Range("K" & i) = Null
                Range("G" & i + 1) = Format(DateValue(Range("G" & i)) + 1)
    Range("I" & i + 1) = Null
        i = i + 1
    End If
    Next

    
    Columns("BH:BH").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

        For i = 5 To Range("a65536").End(xlUp).Row
   
            If Sheets(1).Range("S" & i) <> "" Then
                Sheets(1).Range("BH" & i) = Sheets(1).Range("S" & i)
            ElseIf Sheets(1).Range("O" & i) <> "" Then
                Sheets(1).Range("BH" & i) = Sheets(1).Range("O" & i)
            Else
                Sheets(1).Range("BH" & i) = Sheets(1).Range("K" & i)
            End If
            
        Next
        
        
    
    Set te = wb.Worksheets(1)
    te.Columns("L:BG").Delete Shift:=xlToLeft
‘    te.Range("L:BG").Delete Shift:=xlToLeft

    Set te = wb.Worksheets(1)
    te.Columns("J").Delete Shift:=xlToLeft
    
    Set te = wb.Worksheets(1)
    te.Columns("H").Delete Shift:=xlToLeft

    Set te = wb.Worksheets(1)
    te.Columns("E").Delete Shift:=xlToLeft

    Set te = wb.Worksheets(1)
    te.Columns("A:C").Delete Shift:=xlToLeft
    
    
    
    Set te = wb.Worksheets(1)
    ‘te.Rows("1:2").Delete Shift:=xlUp
    te.Range("1:2").Delete Shift:=xlUp
    

    Set te = wb.Worksheets(1)
    te.Columns("B").Delete Shift:=xlToLeft
    
Dim a As Integer
For a = 4 To 20000 Step 2
    wb.Sheets(1).Rows(a).Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
Next
    
    ‘保存表格,如果没有这一步的话,前面的操作不会保存;
    ActiveWorkbook.Save
    ‘关闭表格
    wb.Close
    ‘ 恢复提醒
    Excel.Application.DisplayAlerts = True
End Sub


Sub 第二步_复制整理好数据()
Dim str As String
‘将上述处理好的表格复制到当前工作薄里面,在这里面会当做是sheet2
For i = 1 To 350
    Set wb = Workbooks.Open("c:\data\钉钉_打卡.xlsx")
    wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    
    wb.Close
    
    If str = "" Then
    Exit For
    End If
  Next
End Sub

Sub 三处理数据()
Sheets(1).Select
For i = 3 To Sheets(2).Range("a65536").End(xlUp).Row
    Sheets(1).Range("a" & i + 1) = Sheets(2).Range("a" & i)
    Sheets(1).Range("b" & i + 1) = Split(Sheets(2).Range("b" & i), " ")(0)
    If i Mod 2 = 0 Then
        Sheets(1).Range("c" & i + 1) = Sheets(2).Range("c" & i)
    Else
        Sheets(1).Range("c" & i + 1) = Sheets(2).Range("E" & i)
    End If
Next
End Sub

Sub 四再处理一次()
Sheets(1).Select
    For i = Sheets(1).Range("a65536").End(xlUp).Row To 3 Step -1
        If Sheets(1).Range("c" & i) = "" Then
            Range("c" & i).Select
            Selection.EntireRow.Delete
        End If
    Next
    
    Cells.Replace What:="次日", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Excel.Application.DisplayAlerts = False
Sheets(2).Delete
Excel.Application.DisplayAlerts = True
End Sub

VBA_打卡

原文:https://www.cnblogs.com/yizhangheka/p/14592866.html

(0)
(0)
   
举报
评论 一句话评论(0
关于我们 - 联系我们 - 留言反馈 - 联系我们:wmxa8@hotmail.com
© 2014 bubuko.com 版权所有
打开技术之扣,分享程序人生!