考勤表格制作

前几天有个行政MM来找我哭诉，各种心软，于是周日花了时间修改一下网上大师代码。

首先感谢大师们！

Sub kaoqinfenxi()
Dim RowB, RowA, iRow, iCol, iRQ, jRow, jCol As Integer
Dim sXM, x1, x2, y, m, n As String
Dim Rng As Range

    RowA = Sheets("考勤记录").Range("A65536").End(xlUp).Row
    For iRow = 2 To RowA
        x1 = LTrim(Sheets("考勤记录").Cells(iRow, 3)) '循环读取考勤记录-时段1签到
        x2 = LTrim(Sheets("考勤记录").Cells(iRow, 4)) '循环读取考勤记录-时段1签退
        y = RTrim(Sheets("考勤记录").Cells(iRow, 2))  '并提取出人名、日期、时间
        sXM = Sheets("考勤记录").Range("A" & iRow)
        With Sheets("考勤表")
            RowB = .Range("A65536").End(xlUp).Row               '最后一行的行号
            Set Rng = .Range("A6:A" & RowB).Find(what:=sXM, LookIn:=xlValues, LookAt:=xlWhole)  '查找要分析的人员所在位置
            If Rng Is Nothing Then    '判断要分析的人员是否存在于分析表中
                .Range("A2:AG4").Copy Destination:=.Range("A" & RowB + 1)   '如果不存在就新建一条记录
                .Cells(RowB + 3, 1) = sXM         '并赋值人名、时间
               
                
                .Cells(RowB + 1, Day(y) + 2) = x1
                .Cells(RowB + 2, Day(y) + 2) = x2
                 
                 If (x2 = "" Or x1 = "") Then
                   .Cells(RowB + 3, Day(y) + 2) = 0
                 ElseIf Minute(x2 - x1) < 30 Then     '按要求计算工时
                              .Cells(RowB + 3, Day(y) + 2) = Hour(x2 - x1)
                 Else: .Cells(RowB + 3, Day(y) + 2) = Hour(x2 - x1) + 0.5
                 End If
          
            ElseIf .Cells(Rng.Row - 2, Day(y) + 2) = "" Then                '如果无数据就肯定是第一次打卡
                .Cells(Rng.Row - 2, Day(y) + 2) = x1
                .Cells(Rng.Row - 1, Day(y) + 2) = x2
                
                 If (x2 = "" Or x1 = "") Then
                   .Cells(Rng.Row, Day(y) + 2) = 0
                 ElseIf Minute(x2 - x1) < 30 Then     '按要求计算工时
                              .Cells(Rng.Row, Day(y) + 2) = Hour(x2 - x1)
                 Else: .Cells(Rng.Row, Day(y) + 2) = Hour(x2 - x1) + 0.5
                 End If
                  
             
            End If
           
            
        End With
    Next
   
End Sub

转载于:https://blog.51cto.com/5456032/1735913