【VBA研究】如何简单的汇总一年12张Excel工资表

版权声明：本文为博主原创文章，未经博主允许不得转载。 https://blog.csdn.net/iamlaosong/article/details/89329634

作者：iamlaosong

这个事情本身并不是什么难题，只是把12个月的月表数据按姓名进行合计，但是每个月中人员并不相同，有走的，也有新加入的。开始想用公式实现，实现时发现非常麻烦，主要是人员不定，就算弄好了，估计速度也成问题。还有一个办法，就是将12张表合并到一张表中，再按姓名进行分类汇总或者做个数据透视表，但手工合并也挺费工夫。用代码实现，自然简单，不涉及什么高深的技术，唯一要注意的就是采用数组，这样处理速度快。

如上图，将12个月中相关列按姓名进行汇总，点击按钮即可完成，速度很快。代码如下：

Sub HuiZong()
    Dim arrXMs(), arrAAs(), arrAHs(), arrAMs()
    Dim arrXMt(1000, 5)
    Dim MaxRow, RYNo, RYCur As Integer
    Dim stName As String
    
    For mm = 1 To 12
        stName = mm & "月"
        RYCur = Sheets(stName).Range("G3").End(xlDown).Row
        arrXMs() = Sheets(stName).Range("G3:G" & RYCur).Value
        arrAAs() = Sheets(stName).Range("AA3:AA" & RYCur).Value
        arrAHs() = Sheets(stName).Range("AH3:AH" & RYCur).Value
        arrAMs() = Sheets(stName).Range("AM3:AM" & RYCur).Value
        RYCur = RYCur - 2
        If mm = 1 Then
            '1月直接赋值
            For k = 1 To RYCur
                arrXMt(k, 1) = arrXMs(k, 1)
                arrXMt(k, 2) = arrAAs(k, 1)
                arrXMt(k, 3) = arrAHs(k, 1)
                arrXMt(k, 4) = arrAMs(k, 1)
                arrXMt(k, 5) = mm & " "
            Next k
            RYNo = RYCur
        Else
            '其他月份汇总
            For k = 1 To RYCur
                For kk = 1 To RYNo
                    If arrXMt(kk, 1) = arrXMs(k, 1) Then Exit For
                Next kk
                If kk > RYNo Then
                    '没有找到，新进人员，增加一条记录
                    arrXMt(kk, 1) = arrXMs(k, 1)
                    arrXMt(kk, 2) = arrAAs(k, 1)
                    arrXMt(kk, 3) = arrAHs(k, 1)
                    arrXMt(kk, 4) = arrAMs(k, 1)
                    arrXMt(kk, 5) = mm & " "
                    RYNo = kk
                Else
                    '找到，进行汇总
                    arrXMt(kk, 2) = arrXMt(kk, 2) + arrAAs(k, 1)
                    arrXMt(kk, 3) = arrXMt(kk, 3) + arrAHs(k, 1)
                    arrXMt(kk, 4) = arrXMt(kk, 4) + arrAMs(k, 1)
                    arrXMt(kk, 5) = arrXMt(kk, 5) & mm & " "
                End If
            Next k
        End If
    Next mm
    '将结果填入表中
    stName = "汇总"
    With Sheets(stName)
        MaxRow = .UsedRange.Rows.Count
        If MaxRow > 2 Then
            .Range("A3:E" & MaxRow).ClearContents
        End If
        For kk = 1 To RYNo
            For k = 1 To 5
                .Cells(kk + 2, k) = arrXMt(kk, k)
            Next k
        Next kk
    End With
    msg = MsgBox("汇总完毕，共汇总" & RYNo & "个人员！", vbOKOnly, "ＡＨＥＭＳ：iamlaosong")
        
End Sub