VBA实现考勤数据整理，希望高手解答，在线等！

ahh0511

如题，使用VBA实现分散的考勤数据整理在一张表上（详情见附件），同时，针对多次打卡记录，仅保留第一条和最后一条记录，中间的记录忽略不计。

ahh0511

希望高手解答，必送鲜花！

三分醉，七分醒

数据有点乱，看一下是不是这个效果

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     With Worksheets("原始数据")
   
5.         r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
   
6.         c = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
   
7.         arr = .Range("a4").Resize(r - 3, c)
   
8.     End With
   
9.     ReDim brr(1 To (UBound(arr) - 1) / 2, 1 To 34)
   
10.     m = 0
    
11.     For i = 2 To UBound(arr) Step 2
    
12.         m = m + 1
    
13.         brr(m, 1) = arr(i, 3)
    
14.         brr(m, 2) = arr(i, 11)
    
15.         brr(m, 3) = arr(i, 21)
    
16.         For j = 1 To UBound(arr, 2)
    
17.             n = arr(1, j) + 3
    
18.             If Len(arr(i + 1, j)) >= 10 Then
    
19.                 brr(m, n) = Left(arr(i + 1, j), 5) & vbLf & Right(arr(i + 1, j), 5)
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     With Worksheets("想要的效果")
    
24.         .UsedRange.Offset(1, 0).Clear
    
25.         With .Range("a2").Resize(UBound(brr), UBound(brr, 2))
    
26.             .Value = brr
    
27.             .Borders.LineStyle = xlContinuous
    
28.             With .Font
    
29.                 .Name = "微软雅黑"
    
30.                 .Size = 10
    
31.             End With
    
32.         End With
    
33.     End With
    
34. End Sub
    

复制代码

chxw68

这应该是考勤机导出的数据，见过好多回了。

ahh0511

chxw68 发表于 2023-5-4 21:27
这应该是考勤机导出的数据，见过好多回了。

谢谢前辈，非常感谢~~~

ahh0511

三分醉，七分醒 发表于 2023-5-4 20:52
数据有点乱，看一下是不是这个效果

谢谢帮助，这个方案也比较简洁~~~

ahh0511

chxw68 发表于 2023-5-4 21:27
这应该是考勤机导出的数据，见过好多回了。

前辈好，若数据整理完后，再根据部门拆分成独立的工作簿呢，该如何高效实现？

ahh0511

chxw68 发表于 2023-5-4 21:27
这应该是考勤机导出的数据，见过好多回了。

前辈，可否根据部门拆分成独立的工作簿，单独保存呢