|
|
Sub biaojiyanse()
Dim rn1 As Range, rn2 As Range, rn3 As Range
With ActiveSheet
r = .Cells(Rows.Count, 2).End(xlUp).Row
y = .Cells(2, Columns.Count).End(xlToLeft).Column
If r < 4 Then MsgBox "考勤表为空，请先导入数据！": End
ar = .Range(.Cells(1, 1), .Cells(r, y))
sb = "8:00:00" ' .[d1]
xb = "17:00:00" ' .[g1]
For i = 4 To UBound(ar)
For j = 3 To UBound(ar, 2)
x = 0: w = 0
If ar(i, j) <> Empty Then
If ar(i, j) <> "-" Then
If InStr(ar(i, j), Chr(10)) = 0 Then
sj = ar(i, j)
If TimeValue(sj) > TimeValue(sb) And TimeValue(sj) < TimeValue("12:00:00") Then
If rn1 Is Nothing Then
Set rn1 = .Cells(i, j) ''迟到
Else
Set rn1 = Union(rn1, .Cells(i, j))
End If
ElseIf TimeValue(sj) > TimeValue("12:00:00") And TimeValue(sj) < TimeValue(xb) Then
If rn2 Is Nothing Then
Set rn2 = .Cells(i, j) ''早退
Else
Set rn2 = Union(rn2, .Cells(i, j))
End If
End If
ElseIf InStr(ar(i, j), Chr(10)) > 0 Then
rr = Split(ar(i, j), Chr(10))
sj_1 = rr(0)
If TimeValue(sj_1) > TimeValue(sb) And TimeValue(sj_1) < TimeValue("12:00:00") Then
x = x + 1
If rn1 Is Nothing Then
Set rn1 = .Cells(i, j)
Else
Set rn1 = Union(rn1, .Cells(i, j))
End If
End If
sj_2 = rr(UBound(rr))
If TimeValue(sj_2) > TimeValue("12:00:00") And TimeValue(sj_2) < TimeValue(xb) Then
w = w + 1
If rn2 Is Nothing Then
Set rn2 = .Cells(i, j)
Else
Set rn2 = Union(rn2, .Cells(i, j))
End If
End If
If x <> 0 And w <> 0 Then
If rn3 Is Nothing Then
Set rn3 = .Cells(i, j)
Else
Set rn3 = Union(rn3, .Cells(i, j))
End If
End If
End If
End If
End If
Next j
Next i
.Range(.Cells(4, 1), .Cells(r, y)).Interior.ColorIndex = 0
If Not rn1 Is Nothing Then rn1.Interior.ColorIndex = 23
If Not rn2 Is Nothing Then rn2.Interior.ColorIndex = 22
If Not rn3 Is Nothing Then rn3.Interior.ColorIndex = 6
End With
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-4-11 09:16
