考勤表汇总

mmxxuhui

各位大神，我在学习考勤表制作，但在汇总时就不知道如何操作了，因为每月人数有增减，并且每月又不是单标题行，所以请大神帮我写一个汇总公式，谢谢！

3190496160

Sub 考勤汇总()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim ar As Variant
Dim sh As Worksheet
Dim br()
ReDim br(1 To 1000, 1 To 6)
For Each sh In Sheets
    If sh.Name <> "汇总表" Then
        y = sh.Cells(3, Columns.Count).End(xlToLeft).Column
        x = sh.Cells(Rows.Count, 1).End(xlUp).Row
        ar = sh.Range(sh.Cells(1, 1), sh.Cells(x, y))
        For i = 6 To UBound(ar)
            If Trim(ar(i, 2)) <> "" And Trim(ar(i, 3)) <> "" Then
                s = Trim(ar(i, 2)) & "|" & Trim(ar(i, 3))
                t = d(s)
                If t = "" Then
                    k = k + 1
                    d(s) = k
                    t = k
                    br(k, 1) = k
                    br(k, 2) = ar(i, 2)
                    br(k, 3) = ar(i, 3)
                End If
                br(t, 4) = br(t, 4) + ar(i, UBound(ar, 2) - 2)
                br(t, 5) = br(t, 5) + ar(i, UBound(ar, 2) - 1)
                br(t, 6) = br(t, 6) + ar(i, UBound(ar, 2))
            End If
        Next i
    End If
Next sh
With Sheets("汇总表")
    .[a1].CurrentRegion.Offset(3) = Empty
    .[a4].Resize(k, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub

3190496160

考勤汇总表.rar (27.94 KB, 下载次数: 122)

2020-10-2 22:54 上传

点击文件名下载附件

mmxxuhui

vba我一点儿都不懂，有没有函数公式呢？谢谢

pj1238

看一下，是不是要这样的效果

zt1210

点都不动VBA！！！嘿嘿