多表汇总再合并

1、说明：每月的人员都有变动，且有重名的出现，

2、要求：效果是名字别出现遗漏.统计出每月的数据。

3、说明：此表我只选择了三张表，其实有12张表。

4、要求：能不能实现有几张表就统计几张表的？

例如，我只有6、7、8三个月，就统计出这三个月的，如果有1、2、3、4、5这几个月的，就统计这五个月的。

         此表为汇总的最终结果

 VBA代码如下：

Sub 多表汇总合并()

    Dim Sht As Worksheet,Arr, Brr

    Dim Dic As Object, x%,i&, k&, y&

    Set Dic =CreateObject("Scripting.Dictionary")

    ReDim Brr(1 ToRows.Count, 1 To 14)

    For Each Sht InSheets

       If Sht.Name <> Sheet5.Name Then

           Arr =Sht.UsedRange

           x =Val(Arr(1, 1)) + 2

           For i = 4To UBound(Arr)

              If Arr(i, 1) <> "" AndArr(i, 2) <> "" Then

                 If Not Dic.Exists((Arr(i, 1) & Arr(i, 2)))Then

                     k = k +1

                     Dic.AddArr(i, 1) & Arr(i, 2), k

                     Brr(k, 1)= Arr(i, 1)

                     Brr(k, 2)= Arr(i, 2)

                     Brr(k, x)= Arr(i, 3)

                 Else

                     y =Dic(Arr(i, 1) & Arr(i, 2))

                     Brr(y, x)= Brr(y, x) + Arr(i, 3)

                 End If

              End If

           Next

       End If

    Next

   Sheet5.UsedRange.Offset(1).ClearContents

   Sheet5.Range("A2").Resize(k, 14) = Brr

End Sub