考勤表的分析统计

Qs18

1. Sub qs() '2024/10/24
   
2. Application.ScreenUpdating = False
   
3. Dim arr, i
   
4. arr = Sheet2.Range("a1").CurrentRegion.Value
   
5. brr = Sheet2.Range("a1").CurrentRegion.Value
   
6. st1 = TimeValue("7:00"): st2 = TimeValue("9:30")
   
7. xt1 = TimeValue("14:30"): xt2 = TimeValue("16:30")
   
8. For i = 3 To UBound(arr)
   
9.     For j = 3 To UBound(arr, 2)
   
10.         If arr(i, j) = "" Then
    
11.             brr(i, j) = "打卡信息不全"
    
12.         Else
    
13. 
    
14.                 a = Split(arr(i, j), Chr(10))
    
15.                 aa = ""
    
16.                 For ai = LBound(a) To UBound(a)
    
17.                     If Len(a(ai)) > 0 Then
    
18.                         aa = aa & "," & a(ai)
    
19.                     End If
    
20.                 Next ai
    
21.                 aa = Split(Mid(aa, 2), ",")
    
22.                 If UBound(aa) = 0 Then
    
23.                     brr(i, j) = "打卡信息不全"
    
24.                 Else
    
25.                 xx = TimeValue(aa(UBound(aa))) - TimeValue(aa(0))
    
26.                 xx = Format(xx, "hh:mm:ss")
    
27.                 brr(i, j) = xx
    
28.                 End If
    
29.     End If
    
30.     Next j
    
31. Next i
    
32. Sheet2.Range("AF1").Resize(10000, 100) = Empty
    
33. Sheet2.Range("AF1").Resize(UBound(arr), UBound(arr, 2)) = brr
    
34. Application.ScreenUpdating = True
    
35. End Sub
    

复制代码

Qs18

试试..........

Qs18

试试..........

哈喽哈哈1

Qs18 发表于 2024-10-24 13:24
试试..........

厉害厉害，已经完成了。谢谢

山海风云轩

做个记号，学习学习

ctrdstruaa

EXCEL2016打开，代码区为空，不能执行运算