|
|
Sub 签到统计()
Dim ar As Variant
Dim r As Long
Dim d As Object
Dim zcks As Date, zcjs As Date, zzcks As Date, zzcjs As Date
Set d = CreateObject("scripting.dictionary")
ar = Sheets("打卡时间").UsedRange.Value
With Sheets("打卡情况")
zcks = .[c1]
zcjs = .[c2]
zzcks = .[d1]
zzcjs = .[d2]
.UsedRange.Offset(5).Borders.LineStyle = 0
.UsedRange.Offset(5) = Empty
br = .Range("a4:bn" & UBound(ar))
For j = 3 To UBound(br, 2) Step 2
d(Val(br(1, j))) = j
Next j
n = 2
For i = 5 To UBound(ar) Step 3
If ar(i, 12) <> "" Then
n = n + 1
br(n, 1) = n
br(n, 2) = ar(i, 12)
For j = 2 To UBound(ar, 2)
If ar(i + 2, j) <> "" Then
rr = Split(ar(i + 2, j), Chr(10))
lh = d(ar(i + 1, j))
For s = 0 To UBound(rr)
If Trim(rr(s)) <> "" Then
ww = CDate(rr(s))
If TimeValue(rr(s)) >= TimeValue(zcks) And TimeValue(rr(s)) <= TimeValue(zcjs) Then
br(n, lh) = "已签"
ElseIf TimeValue(rr(s)) >= TimeValue(zzcks) And TimeValue(rr(s)) <= TimeValue(zzcjs) Then
br(n, lh + 1) = "已签"
ElseIf TimeValue(rr(s)) < TimeValue(zcks) Or (TimeValue(rr(s)) > TimeValue(zcjs) And TimeValue(rr(s)) < TimeValue(zzcks)) Then
br(n, lh) = "缺签"
ElseIf TimeValue(rr(s)) > TimeValue(zzcjs) Then
br(n, lh + 1) = "缺签"
End If
End If
Next s
End If
Next j
End If
Next i
.[a4].Resize(n, UBound(br, 2)) = br
.[a4].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-10-31 07:45
楼主
