vba 考勤代码暂存

发布时间 2023-04-06 17:03:17作者: ice204

Sub x()

'员工ID&name
Dim sb As String
Let sb = "'" & ThisWorkbook.Path & "\[插入新ITEM.xlsm]sheet1'!"
With Sheet2.[A1:BL259]
.FormulaR1C1 = "=" & sb & "RC"
.Value = .Value
End With
With Sheet1.[b2:c257]
.FormulaR1C1 = "=Sheet2!" & "r[2]c[-1]"
.Value = .Value
End With

' MsgBox Cells(2, Range("A2").End(xlToRight).Column - 1)


' 标准工作日
Worksheets("Sheet2").Select
Rows(1).Replace "0", ""
' For i = 1 To ActiveSheet.UsedRange.Columns.Count
' If Cells(2, i) = "0" Then
' Cells(2, i).Replace "0", ""
' End If
' Next
Dim d1 As Date, d2 As Date, wf As WorksheetFunction, mon As Date
Set wf = Application.WorksheetFunction
d1 = DateValue(Cells(2, 3))
'13-句型不一致错误
d2 = DateValue(Cells(2, Range("A2").End(xlToRight).Column - 1))
MsgBox Range("A2").End(xlToRight).Column - 1
MsgBox Cells(2, Range("A2").End(xlToRight).Column - 1)
Worksheets("Sheet1").Select
Range("D2", "D257").Value = wf.NetworkDays(d1, d2)

'异常
Worksheets("Sheet2").Select
Dim yi As Integer
For n = 4 To Range("A4").End(xlDown).Row
For i = 3 To Range("A3").End(xlToRight).Column Step 2
If Cells(n, i) <> "" And Cells(n, i) = Cells(n, i + 1) Then
Cells(n, i).Interior.Color = vbGreen
Cells(n, i + 1).Interior.Color = vbGreen
yi = yi + 1
'MsgBox (i)
End If
Next
Cells(n, "BQ").Value = yi
yi = 0
Next
' Worksheets("Sheet1").Activate
' With Sheet1.[h2:h257]
' .FormulaR1C1 = "=Sheet2!" & "r[2]c[61]"
' .Value = .Value
' End With

'迟到
' Worksheets("Sheet2").Activate
Dim chi As Integer
For n = 4 To Range("A4").End(xlDown).Row
For i = 3 To Range("A3").End(xlToRight).Column Step 2
'判断是不是周末
If Weekday(Cells(2, i)) >= 2 And Weekday(Cells(2, i)) <= 6 Then
'除去异常打卡
If Cells(n, i) <> Cells(n, i + 1) Then
If Cells(n, i) > TimeValue("08:30:00") And Cells(n, i) < TimeValue("09:00:00") Then
Cells(n, i).Interior.Color = vbRed
'Cells(n, i + 1).Interior.Color = vbWhite
chi = chi + 1
End If
End If
End If
Next
Cells(n, "BO").Value = chi
chi = 0
Next
' Worksheets("Sheet1").Activate
' With Sheet1.[f2:f257]
' .FormulaR1C1 = "=Sheet2!" & "r[2]c[61]"
' .Value = .Value
' End With

'出勤次数
' Worksheets("Sheet2").Activate
Dim chu As Integer
For n = 4 To Range("A4").End(xlDown).Row
For i = 3 To Range("A3").End(xlToRight).Column Step 2
If Cells(n, i) <> "" Then
chu = chu + 1
End If
Next
Cells(n, "BP").Value = chu
chu = 0
Next
' Worksheets("Sheet1").Activate
' With Sheet1.[g2:g257]
' .FormulaR1C1 = "=Sheet2!" & "r[2]c[58]"
' .Value = .Value
' End With
' Worksheets("Sheet2").Activate
Dim time As Integer
For n = 4 To Range("A4").End(xlDown).Row
For i = 3 To Range("A3").End(xlToRight).Column Step 2
If Cells(n, i) <> Cells(n, i + 1) Then
'12点之前上班
If Cells(n, i) < TimeValue("12:00:00") Then
'1点之前下班 -0
If Cells(n, i + 1) < TimeValue("13:00:00") Then
time = time + DateDiff("h", Cells(n, i), Cells(n, i + 1))
'18点之后下班 -2
ElseIf Cells(n, i + 1) < TimeValue("18:30:00") Then
time = time + DateDiff("h", Cells(n, i), Cells(n, i + 1)) - 2
'1点到18点半之间下班 -1
Else
time = time + DateDiff("h", Cells(n, i), Cells(n, i + 1)) - 1
End If
'12点之后上班
Else
'18点之后下班 -1
If Cells(n, i + 1) < TimeValue("18:30:00") Then
time = time + DateDiff("h", Cells(n, i), Cells(n, i + 1)) - 1
'1点到18点半之间下班 -1
Else
time = time + DateDiff("h", Cells(n, i), Cells(n, i + 1))
End If
End If
End If
Next
Cells(n, "BN").Value = time
time = 0
Next
Worksheets("Sheet1").Activate
With Sheet1.[e2:h257]
.FormulaR1C1 = "=Sheet2!" & "r[2]c[61]"
.Value = .Value
End With
End Sub