如何把考勤记录按人按日期分别显示

赵丰海

如何把考勤记录按人按日期分别显示，原始记录打印出来太多页了，看着也不直观

HSIAOQIANG

365新函數

赵丰海

HSIAOQIANG 发表于 2022-9-30 12:28
365新函數

EXCEL2013有没有办法实现？

3190496160

Sub fenlei()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim brr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("分类前")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:c" & rs)
End With
For i = 1 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        If Not d.exists(Trim(ar(i, 1))) Then
            Set d(Trim(ar(i, 1))) = CreateObject("scripting.dictionary")
        End If
        d(Trim(ar(i, 1)))(ar(i, 2)) = d(Trim(ar(i, 1)))(ar(i, 2)) & "|" & ar(i, 3)
    End If
Next i
ReDim brr(1 To UBound(ar), 1 To 7)
For Each k In d.keys
    x = d(k).keys ''
    xx = d(k).items ''
    For s = 0 To UBound(x)
        tt = x(s)
        n = n + 1
        brr(n, 1) = k
        brr(n, 2) = x(s)
        m = xx(s)
        rr = Split(m, "|")
        lh = 2
        For j = 1 To UBound(rr)
            If Trim(rr(j)) <> "" Then
                lh = lh + 1
                brr(n, lh) = rr(j)
            End If
        Next j
    Next s
Next k
With Sheets("分类后")
    .[a1].CurrentRegion.Offset(1).Borders.LineStyle = 0
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(n, UBound(brr, 2)) = brr
    .[a2].Resize(n, UBound(brr, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160

2022.09.rar (66.08 KB, 下载次数: 13)

2022-9-30 16:55 上传

点击文件名下载附件

3190496160

2022.09.rar (66.08 KB, 下载次数: 18)

2022-9-30 16:56 上传

点击文件名下载附件

HSIAOQIANG

赵丰海 发表于 2022-9-30 13:26
EXCEL2013有没有办法实现？

那我就不知道了

3190496160

有些打开记录一天不止四次，代码仅供参考

赵丰海

3190496160 发表于 2022-9-30 16:56

谢谢

sunya_0529

正常处理考勤需要每天的上班时间（最早时间）和下班时间（最晚时间），这种情况下，用数据透视表最方便，如下图所示——



如果需要像求助附件里的格式，把所有的打卡时间都列出来，需要借助于VBA，代码如下——

1. Option Explicit
   
2. 
   
3. Sub ShowData()
   
4. Dim c As Range, i%, j%, arr(999, 9)
   
5. With Sheet1
   
6.   For Each c In .Range("A2:A" & .[A2].End(xlDown).Row)
   
7.     If c.Value <> c.Offset(-1, 0).Value Then
   
8.       j = 0
   
9.       arr(i, j) = c.Value
   
10.       arr(i, j + 1) = c.Offset(0, 1).Value
    
11.       arr(i, j + 2) = Format(c.Offset(0, 2).Value, "hh:mm:ss")
    
12.       i = i + 1
    
13.     Else
    
14.       If c.Offset(0, 1).Value = c.Offset(-1, 1).Value Then
    
15.         j = j + 1
    
16.         arr(i - 1, j + 2) = Format(c.Offset(0, 2).Value, "hh:mm:ss")
    
17.       End If
    
18.     End If
    
19.   Next
    
20. End With
    
21. With Sheet2.[A2].Resize(1000, 10)
    
22.   .Cells.ClearContents
    
23.   .Cells = arr
    
24.   .Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 2), order2:=xlAscending, Header:=xlGuess
    
25. End With
    
26. End Sub

复制代码

具体效果看附件吧——