考勤数据分析

jhjxy

一把小刀闯天下 发表于 2018-7-9 13:33
'只写了科室的

'如果没有单刷出现（就是忘刷），白班、夜班可以判断。而实际情况是会出现的，所以没有办 ...

哦，谢谢！！！！！！！！！！

jhjxy

一把小刀闯天下 发表于 2018-7-9 13:33
'只写了科室的

'如果没有单刷出现（就是忘刷），白班、夜班可以判断。而实际情况是会出现的，所以没有办 ...

这个是附件！！！！！！

jhjxy

一把小刀闯天下 发表于 2018-7-9 13:33
'只写了科室的

'如果没有单刷出现（就是忘刷），白班、夜班可以判断。而实际情况是会出现的，所以没有办 ...

以这份附件为准

一把小刀闯天下

jhjxy 发表于 2018-7-19 14:11
以这份附件为准

'只给你计算了每个人的工作天数、工时，工时的计算规则并不明确

'表"3"需要自动转换成"考勤表"？红色底纹的是否考勤异常？
'如果是考勤异常需要自动判断是否为白班、早班、夜班？

'纯属体力活，这得先要理解了才能写，不然修改起来挺费劲

Option Explicit

Sub test()
  Dim arr, i, j, sum, t
  With Sheets("考勤表")
    arr = .Range("a1:ah" & .Cells(Rows.Count, "c").End(xlUp).Row)
    For i = 7 To UBound(arr, 1) Step 3
      sum = 0
      For j = 4 To UBound(arr, 2)
        If Len(arr(i, j)) > 0 And Len(arr(i + 1, j)) > 0 Then
          arr(i + 2, j) = (arr(i + 1, j) - arr(i, j)) * 24
          t = arr(i + 2, j) - Int(arr(i + 2, j))
          arr(i + 2, j) = Int(arr(i + 2, j)) + IIf(t >= 0.5, 0.5, 0) '工时计算规则
          If arr(i + 2, j) > 8 Then sum = sum + 1
        End If
      Next
      arr(i + 2, 2) = sum
    Next
    .[a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
  End With
End Sub

jhjxy

一把小刀闯天下 发表于 2018-7-19 15:32
'只给你计算了每个人的工作天数、工时，工时的计算规则并不明确

'表"3"需要自动转换成"考勤表"？红色 ...

工时的计算就是下班时间减去上班时间

jhjxy

一把小刀闯天下 发表于 2018-7-19 15:32
'只给你计算了每个人的工作天数、工时，工时的计算规则并不明确

'表"3"需要自动转换成"考勤表"？红色 ...

车间里的工人会有晚班的

一把小刀闯天下

jhjxy 发表于 2018-7-19 16:14
车间里的工人会有晚班的

'先插入一个"sheet2"工作表
'只写了一个位置转换，确认一下位置是否正确。你这考勤表的示例很多是错误的，晚班签到你写到离开那里去了
'后面的工时计算其实上个帖子已经写了，稍作修改加进去就可以了。错误判断结果已经放flag数组中去了

'另外源数据表的11?12?13行数据能否解释一下

Option Explicit

Sub test()
  Dim arr, i, j, k, dic, t, brr, cnt, id, m, td, tm, flag
  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 '早班签到
                brr(3 * (m - 1) + 1, dic(td)) = tm
                If tm > mark(2)(0) Then flag(3 * (m - 1) + 1, dic(td)) = 1 '早班迟到
              Else '早班离开
                brr(3 * (m - 1) + 2, dic(td)) = tm
                If tm < mark(2)(1) Then flag(3 * (m - 1) + 2, dic(td)) = 1 '早班早退
              End If
              '工时计算
            Else '晚班
              If tm > #12:00:00 PM# Then '晚班签到
                brr(3 * (m - 1) + 1, dic(td)) = tm
                If tm > mark(3)(0) Then flag(3 * (m - 1) + 1, dic(td)) = 1 '晚班迟到
              Else
                brr(3 * (m - 1) + 2, dic(td)) = tm
                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 '白班签到
                brr(3 * (m - 1) + 1, dic(td)) = tm
                If tm > mark(1)(0) Then flag(3 * (m - 1) + 1, dic(td)) = 1 '白班迟到
              Else '白班离开
                brr(3 * (m - 1) + 2, dic(td)) = tm
                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
  With Sheets("sheet2").[a7]
    .Resize(Rows.Count - 6, UBound(brr, 2)).ClearContents
    .Offset(, 3).Resize(UBound(brr, 1), UBound(brr, 2)).NumberFormatLocal = "h:mm;@"
    .Resize(UBound(brr, 1), UBound(brr, 2)) = brr
  End With
End Sub

jhjxy

是这三行数据吗

jhjxy

这三行数据有什么问题

jhjxy

一把小刀闯天下 发表于 2018-7-20 07:31
'先插入一个"sheet2"工作表
'只写了一个位置转换，确认一下位置是否正确。你这考勤表的示例很多是错误的 ...

位置转换是对的