|
|
增加3张表
然后，粘贴上以下代码（公司电脑，文档有加密）所以贴代码
Sub 考勤转换()
' https://club.excelhome.net/thread-1695078-1-1.html
' 2024-6-18
Sheet5.Select
Cells.NumberFormatLocal = "@"
Cells.ClearContents ' 清空上一次的统计数据
Cells.Interior.ColorIndex = xlNone
Cells(1, 1).Value = "工号"
Cells(1, 2).Value = "姓名"
Cells(1, 3).Value = "部门"
For i = 1 To 31
Cells(1, i + 3).Value = i ' 写上日期
Next i
x5 = 1
jsh = Sheet3.UsedRange.Rows.Count ' 依据数据范围，获得行数，尾部数据隐藏不影响计数
For x3 = 5 To jsh
If Sheet3.Cells(x3, 9).Value = "姓 名:" Then ' 找到姓名，则
x5 = x5 + 1
Sheet5.Cells(x5, 1).Value = Sheet3.Cells(x3, 3).Value ' 记录工号
Sheet5.Cells(x5, 2).Value = Sheet3.Cells(x3, 11).Value ' 记录姓名
Sheet5.Cells(x5, 3).Value = Sheet3.Cells(x3, 21).Value ' 记录部门
For y = 1 To 31 ' 按日期循环
bb = Sheet3.Cells(x3 + 1, y).Value
mysj = ""
For i = 1 To Len(bb)
If Mid(bb, i, 1) = ":" Then
wz = i
mysj = mysj & Mid(bb, wz - 2, 5) & Chr(10) ' 2个时间值间加上换行符
End If
Next i
Sheet5.Cells(x5, y + 3).Value = mysj ' 记录一天的考勤
Next y
End If
Next x3
End Sub
Sub 考勤取最值()
Sheet6.Select
Cells.NumberFormatLocal = "@"
Cells.ClearContents ' 清空上一次的统计数据
Sheet5.Columns("A:C").Copy ' 复制部门、工号、姓名
Sheet6.Cells(1, 1).Select
ActiveSheet.Paste ' 粘贴
For i = 1 To 31
Cells(1, i + 3).Value = i ' 写上日期
Next i
x6 = 2
Do While Not (IsEmpty(Sheet6.Cells(x6, 1).Value))
xm = Sheet6.Cells(x6, 1).Value
x5 = 2
Do While Not (IsEmpty(Sheet5.Cells(x5, 1).Value))
If Sheet5.Cells(x5, 1).Value = xm Then
For y = 1 To 31
If InStr(1, Sheet5.Cells(x5, y + 3).Value, ":", 1) <> 0 Then ' 如果有时间数
If mymax(Sheet5.Cells(x5, y + 3).Value, "A") = mymax(Sheet5.Cells(x5, y + 3).Value, "Z") Then ' 如果最大＝最小，说明只打卡1次
Sheet6.Cells(x6, y + 3).Value = mymax(Sheet5.Cells(x5, y + 3).Value, "A")
Else
Sheet6.Cells(x6, y + 3).Value = mymax(Sheet5.Cells(x5, y + 3).Value, "A") & Chr(10) & mymax(Sheet5.Cells(x5, y + 3).Value, "Z")
End If
End If
Next y
End If
x5 = x5 + 1
Loop
x6 = x6 + 1
Loop
Range("A1").Select
End Sub
Function mymax(c_sj As String, Optional Options As String = "A") ' 接收数值的变量是 n 。Integer 类型的值只有5位数。 Variant 类型的数值范围最大
' 这是第一次用自定义函数，2022-10-14星期五
' 于2022-10-24星期一，将最大值和最小值二个自定义数合二为一，关键是括号中，增加“, Optional Options As String = "A" ”，变成一个接收数据，一个接收类型标记
' 这个自定义函数是算出最大值（一天打卡时间中的最大）
Dim arr(10)
Dim maxsj As String
maxsj = "00:00"
minsj = "99:99"
js = 0
ks = 1
For i = 1 To Len(c_sj)
If Mid(c_sj, i, 1) = Chr(10) Then
js = js + 1 ' 这个计数是为记录，换行符第几次出现
arr(js) = Mid(c_sj, ks, i - ks) ' arr(js)里，记录了 js 个时间值
ks = i + 1
End If
Next i
arr(js + 1) = Mid(c_sj, ks) ' 通过对接收到的数据，进行分享，暂存数组中
For j = 1 To js + 1
If arr(j) > maxsj Then 'And InStr(1, arr(j), ":", 1) <> 0 Then
maxsj = arr(j) ' 从数组中取出最大值
End If
If arr(j) < minsj And arr(j) <> " " And arr(j) <> "" Then
minsj = arr(j) ' 从数组中取出最小值
End If
Next j
If UCase(Options) = "A" Then
mymax = minsj ' 将处理的结果，反馈给 SUB ，再按SUB的规则处理（即赋值给单元格A1）
Else
mymax = maxsj
End If
End Function ' Function ....... End Function 是自定义函数的格式规范
Sub 计算每天的小时数()
'
' 遇到指定的符号（chr(10)）时，取值
'
' 时间：2022-10-17
'
' 思路：取出一天中的最大值与最小值，二值之差即为时间，超过8小时45分的部分为加班
'
Sheet7.Select
Rows("1:1000").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheet6.Select
Cells.Select
Selection.Copy
Sheet7.Select
Range("A1").Select
Selection.PasteSpecial
Range("A1").Select
Cells.Interior.ColorIndex = xlNone ' 所有单元格颜色取消
'---
x7 = 2
Do While Not (IsEmpty(Sheet7.Cells(x7, 3).Value)) ' 在表6中寻找姓名
For y = 1 To 31
minsj = ""
maxsj = ""
c_sj = Sheet7.Cells(x7, y + 3).Value
If IsEmpty(c_sj) Then
Else
If InStr(1, c_sj, Chr(10), 0) = 0 Then
Sheet7.Cells(x7, y + 3).Value = "打卡1次"
Sheet7.Cells(x7, y + 3).Interior.ColorIndex = 34 ' 6-黄色，34－兰色
Else
minsj = Split(c_sj, Chr(10))(0)
maxsj = Split(c_sj, Chr(10))(1)
xs = Hour(maxsj) - Hour(minsj)
fz = Minute(maxsj) - Minute(minsj)
If fz < 0 Then ' 分钟为负数，需要借1小时，化为分钟
xs = xs - 1
fz = fz + 60
End If
Sheet7.Cells(x7, y + 3).Value = xs & "时" & fz & "分"
End If
End If
Next y
x7 = x7 + 1
Loop
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-6-18 09:47
楼主
发表于 2024-6-27 10:14
