考勤数据分析

一把小刀闯天下

jhjxy 发表于 2018-7-20 10:53
是这三行数据吗

'因为IT在夜晚机器上刷的卡，看上下班时间应该归类于科室

'仅转换成考勤表，对多次刷卡进行了处理。看上去好像差不多，自己好好测试一下，看上去晕

'6095173100004的为车间晚班专用打卡机，如果这个条件不成立代码的执行结果是不确定的，可以说是无解，这问题也就算结束了（因为有漏刷、迟到或早退，所以很难根据其它条件也确定夜班）

'其他的计算等可能公式就能搞得定的吧，一步步来

Option Explicit

Sub test()
  Dim arr, i, j, k, dic, t, brr, cnt, id, m, td, tm, flag, wk
  Set dic = CreateObject("scripting.dictionary")
  id = 6095173100004#
  ReDim mark(1 To 3)
  mark(1) = Array(#7:45:00 AM#, #5:05:00 PM#) '科室
  mark(2) = Array(#7:45:00 AM#, #8:05:00 PM#) '车间白班
  mark(3) = Array(#7:45:00 PM#, #8:05:00 AM#) '车间夜班
  With Sheets("3")
    arr = .Range("a2:e" & .Cells(Rows.Count, "a").End(xlUp).Row + 1)
  End With
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 2) <> arr(j + 1, 2) Then
        For k = i To j
          dic(CDate(Split(arr(k, 4))(0))) = vbNullString
        Next
        cnt = cnt + 1: i = j: Exit For
      End If
  Next j, i
  brr = dic.keys: dic.RemoveAll
  For i = 0 To UBound(brr) - 1
    For j = i + 1 To UBound(brr)
      If brr(i) > brr(j) Then
        t = brr(i): brr(i) = brr(j): brr(j) = t
      End If
  Next j, i
  For i = 0 To UBound(brr): dic(brr(i)) = i + 4: Next
  ReDim brr(1 To cnt * 3, 1 To dic.Count + 3)
  flag = brr
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 2) <> arr(j + 1, 2) Then
        m = m + 1
        brr(3 * m, 1) = arr(i, 2): brr(3 * m - 2, 2) = "工作"
        brr(3 * m - 1, 2) = "天数": brr(3 * m - 2, 3) = "签到"
        brr(3 * m - 1, 3) = "离开": brr(3 * m, 3) = "工时"
        For k = i To j
          t = Split(arr(k, 4))
          td = CDate(t(0))
          tm = CDate(t(UBound(t)))
          If InStr(arr(i, 1), "车间") > 0 Then '车间
            If arr(i, 5) <> id Then '早班
              If tm <= #12:00:00 PM# Then '早班签到
                If Len(brr(3 * (m - 1) + 1, dic(td))) > 0 Then '重复刷卡
                  If CDate(brr(3 * (m - 1) + 1, dic(td))) > tm Then brr(3 * (m - 1) + 1, dic(td)) = tm
                Else
                  brr(3 * (m - 1) + 1, dic(td)) = tm
                End If
                brr(3 * (m - 1) + 1, dic(td)) = Format(brr(3 * (m - 1) + 1, dic(td)), "hh:mm")
'                If tm > mark(2)(0) Then flag(3 * (m - 1) + 1, dic(td)) = 1 '早班迟到
              Else '早班离开
                If Len(brr(3 * (m - 1) + 2, dic(td))) > 0 Then '重复刷卡
                  If CDate(brr(3 * (m - 1) + 2, dic(td))) < tm Then brr(3 * (m - 1) + 2, dic(td)) = tm
                Else
                  brr(3 * (m - 1) + 2, dic(td)) = tm
                End If
                brr(3 * (m - 1) + 2, dic(td)) = Format(brr(3 * (m - 1) + 2, dic(td)), "hh:mm")
'                If tm < mark(2)(1) Then flag(3 * (m - 1) + 2, dic(td)) = 1 '早班早退
              End If
              '工时计算
            Else '晚班
              If tm > #12:00:00 PM# Then '晚班签到
                If Len(brr(3 * (m - 1) + 1, dic(td))) > 0 Then '重复刷卡
                  If CDate(brr(3 * (m - 1) + 1, dic(td))) > tm Then brr(3 * (m - 1) + 1, dic(td)) = tm
                Else
                  brr(3 * (m - 1) + 1, dic(td)) = tm
                End If
                brr(3 * (m - 1) + 1, dic(td)) = Format(brr(3 * (m - 1) + 1, dic(td)), "hh:mm")
'                If tm > mark(3)(0) Then flag(3 * (m - 1) + 1, dic(td)) = 1 '晚班迟到
              Else
                If Len(brr(3 * (m - 1) + 2, dic(td))) > 0 Then '重复刷卡
                  If CDate(brr(3 * (m - 1) + 2, dic(td))) < tm Then brr(3 * (m - 1) + 2, dic(td)) = tm
                Else
                  brr(3 * (m - 1) + 2, dic(td)) = tm
                End If
                brr(3 * (m - 1) + 2, dic(td)) = Format(brr(3 * (m - 1) + 2, dic(td)), "hh:mm")
'                If tm < mark(3)(1) Then flag(3 * (m - 1) + 2, dic(td)) = 1 '晚班早退
              End If
              '工时计算
            End If
          Else '科室
            If arr(i, 5) <> id Then
              If tm <= #12:00:00 PM# Then '白班签到
                If Len(brr(3 * (m - 1) + 1, dic(td))) > 0 Then '重复刷卡
                  If CDate(brr(3 * (m - 1) + 1, dic(td))) > tm Then brr(3 * (m - 1) + 1, dic(td)) = tm
                Else
                  brr(3 * (m - 1) + 1, dic(td)) = tm
                End If
                brr(3 * (m - 1) + 1, dic(td)) = Format(brr(3 * (m - 1) + 1, dic(td)), "hh:mm")
'                If tm > mark(1)(0) Then flag(3 * (m - 1) + 1, dic(td)) = 1 '白班迟到
              Else '白班离开
                If Len(brr(3 * (m - 1) + 2, dic(td))) > 0 Then '重复刷卡
                  If CDate(brr(3 * (m - 1) + 2, dic(td))) < tm Then brr(3 * (m - 1) + 2, dic(td)) = tm
                Else
                  brr(3 * (m - 1) + 2, dic(td)) = tm
                End If
                brr(3 * (m - 1) + 2, dic(td)) = Format(brr(3 * (m - 1) + 2, dic(td)), "hh:mm")
'                If tm < mark(1)(1) Then flag(3 * (m - 1) + 2, dic(td)) = 1 '白班早退
              End If
              '工时计算
            End If
          End If
        Next
        i = j: Exit For
      End If
  Next j, i
  ReDim arr(1 To 2, 1 To UBound(brr, 2))
  wk = "日一二三四五六"
  arr(2, 1) = "姓名": arr(1, 3) = "星期": arr(2, 3) = "日起"
  For Each t In dic.keys
    arr(1, dic(t)) = Mid(wk, Weekday(t), 1)
    arr(2, dic(t)) = Format(t, "dd")
  Next
  With Sheets("考勤表").[a7]
    .Resize(Rows.Count - 6, UBound(brr, 2)).ClearContents
'    .Offset(, 3).Resize(UBound(brr, 1), UBound(brr, 2)).NumberFormatLocal = "@"
    .Resize(UBound(brr, 1), UBound(brr, 2)) = brr
    .Offset(-2).Resize(2, UBound(arr, 2)) = arr
  End With
End Sub

jhjxy

一把小刀闯天下 发表于 2018-7-20 12:25
'因为IT在夜晚机器上刷的卡，看上下班时间应该归类于科室

'仅转换成考勤表，对多次刷卡进行了处理。看 ...

这个问题无需考虑，这是测试的。以后不会出现这种问题

一把小刀闯天下

jhjxy 发表于 2018-7-20 16:20
这个问题无需考虑，这是测试的。以后不会出现这种问题

只是在提醒你，可以确定的一件事就是这问题跟我没半毛关系。感觉你顶多算是一个旁观者而不是一个求助者

另外一点夜班你的计算也是错误的，如果1日下夜班就缺少上月的上夜班的记录。一样的道理本月最后一天的夜班也无法计算。

到此为止吧，纯体力活但有些条件并不确定，挺费劲的一件事。这论坛高手不少你还是找找他们或许会得到一些帮助的

jhjxy

一把小刀闯天下 发表于 2018-7-20 20:37
只是在提醒你，可以确定的一件事就是这问题跟我没半毛关系。感觉你顶多算是一个旁观者而不是一个求助者
...

是的，我有这个需求，但我又是菜鸟，不太懂。刚学的VBA。不知从哪里开始。不管怎么样，感谢!!!

jhjxy

一把小刀闯天下 发表于 2018-7-20 20:37
只是在提醒你，可以确定的一件事就是这问题跟我没半毛关系。感觉你顶多算是一个旁观者而不是一个求助者
...

是的，我有这个需求，但我又是菜鸟，不太懂。刚学的VBA。不知从哪里开始。不管怎么样，感谢!!!