打卡机上数据签到汇总

ctrdstruaa · 发表于 2024-10-31 07:45

我想把打卡机上签到数据进行汇总，翻改了一个类似的程序，但总是显示错误，有哪位高手能帮我改一下吗？非常感谢。

shiruiqiang · 发表于 2024-10-31 08:35

https://club.excelhome.net/forum ... amp;_dsign=33899c2c
基本上差不多

ctrdstruaa · 发表于 2024-10-31 08:51

可转换为这种形式吗，便于后期统计数据

z865593849 · 发表于 2024-10-31 09:11

签到打卡的例子

3190496160 · 发表于 2024-10-31 09:42

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

3190496160 · 发表于 2024-10-31 09:42

签到打卡.rar (30.52 KB, 下载次数: 0)

longwin · 发表于 2024-10-31 09:55

附件供参考。。。。。

ctrdstruaa · 发表于 2024-10-31 12:51

完全是我需要的，谢谢高手指导

excel玉米 · 发表于 2024-10-31 17:07

新人求助，如果问题得到解决，请给帮助你的人送朵免费的小花。

		自动登录	找回密码
密码			免费注册