|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 考勤统计()
Application.ScreenUpdating = False
Dim ar As Variant, arr As Variant
Dim d As Object, dc As Object
Dim br()
Dim sMax As String, sMin As String, sTime As String
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("考勤数据")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "考勤数据为空！": End
.Range("a1:d" & r).Sort .[c1], 1, , , , , , 1 '
ar = .Range("a1:d" & r)
End With
For i = 2 To UBound(ar)
If Trim(ar(i, 2)) <> "" And Trim(ar(i, 3)) <> "" Then
zd = Trim(ar(i, 2)) & "|" & Trim(ar(i, 3))
d(zd) = ""
End If
Next i
With Sheets("员工考勤表")
.UsedRange.Offset(3).Clear
arr = .Range("a2:ah" & r)
k = 2
For Each kk In d.keys
n = 0
ReDim br(1 To UBound(ar), 1 To 1)
d.RemoveAll: sMin = "A"
For i = 2 To UBound(ar)
If Trim(ar(i, 2)) <> "" And Trim(ar(i, 3)) <> "" Then
zd = Trim(ar(i, 2)) & "|" & Trim(ar(i, 3))
If zd = kk Then
n = n + 1
br(n, 1) = TimeValue(CDate(Format(ar(i, 4), "h:mm:ss")))
End If
End If
Next i
For i = 1 To n
For s = i + 1 To n
If br(i, 1) > br(s, 1) Then
mk = br(i, 1)
br(i, 1) = br(s, 1)
br(s, 1) = mk
End If
Next s
Next i
rr = Split(kk, "|")
xm = Trim(rr(1))
t = dc(xm)
If t = "" Then
k = k + 3
dc(xm) = k
t = k
arr(k, 1) = xm
arr(k - 2, 2) = "天数/总工时h"
arr(k - 2, 3) = "签到"
arr(k - 1, 3) = "签退"
arr(k, 3) = "工时"
End If
lh = Day(rr(0))
arr(t - 2, lh + 3) = br(n, 1)
arr(t - 1, lh + 3) = br(1, 1)
.Range("D" & t - 1).Resize(1, 31).NumberFormatLocal = "[$-x-systime]h:mm:ss AM/PM"
.Range("D" & t).Resize(1, 31).NumberFormatLocal = "[$-x-systime]h:mm:ss AM/PM"
arr(t, lh + 3) = (arr(t - 2, lh + 3) - arr(t - 1, lh + 3)) * 24
.Range("D" & t + 1).Resize(1, 31).NumberFormatLocal = "0.0_ "
Next kk
.[a2].Resize(k, UBound(arr, 2)) = arr
.[a2].Resize(k, UBound(arr, 2)).Borders.LineStyle = 1
End With
Set d = Nothing
Set dc = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
评分
-
1
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-4-29 18:17
楼主