Excel VBA 7.40跨工作表统计部分类别的数据总和，继续玩转各种非常规数据计算
一起学习，一起进步~~
昨天我们进一步完善了我们的代码，在行列数据求和的工程中，不限制数据的样式，不管是整体还是局部的部分数据求和，都能够实现了，今天我们继续来玩转下数据求和，我们今天要分享的场景是针对部分类型进行求和，也算是上节局部数据分析求和的一个衍生
在之前我们写过一个针对整体数据部分列的求和，7-37（插入链接），那之后就有小伙伴说想要看看是否能够针对部分类别来进行求和，本节也算是满足这部分的小伙伴的需求。
场景简介
先来说说什么是按照类别来进行求和吧，因为之前有小伙伴们比较不太清楚，放在我们今天的案例中来说，就是按照姓名这一列来进行求和
之前我们分享如何获取三个工作表所有不同的姓名列的数据，并且求和，形成一个最终含有所有人的各科成绩的总和，今天我们不求整体，只求部分
虽然局部不能代表整体，但是选取其中部分数据来进行分析，也是数据统计中比较常见的方法。
代码区
Sub TEST()Dim sth As Worksheet, trng As Range, lrng As Range, arr()Set zd = CreateObject("scripting.dictionary")Set trng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)Set lrng = Application.InputBox("请选择要计算的列区域", "计算区域的确定", , , , , , 8)trng.SelectCountR = trng.Rows.CountFirstL = trng.ColumnSumL = lrng.Columns = Cells(CountR, FirstL)j = 0CountNum = 0 '循环的第几个工作表For Each sth In Worksheets CountNum = CountNum + 1 If CountNum = 1 Then l = lrng.Rows.Count l1 = sth.Cells(2, Columns.Count).End(xlToLeft).Column For i = CountR To CountR + l k = sth.Cells(i, 1) If zd.Exists(k) Then If k <> s Then n = zd(k) arr(2, n) = arr(2, n) + sth.Cells(i, SumL) End If Else j = j + 1 zd(k) = j ReDim Preserve arr(1 To l1, 1 To j) For i1 = 1 To l1 arr(i1, j) = sth.Cells(i, i1) Next i1 End If Next i Else l = sth.Cells(Rows.Count, 1).End(xlUp).Row l1 = sth.Cells(2, Columns.Count).End(xlToLeft).Column For i = CountR To l k = sth.Cells(i, 1) If zd.Exists(k) Then If k <> s Then n = zd(k) For i1 = 3 To l1 arr(i1, n) = arr(i1, n) + sth.Cells(i, i1) Next i1 End If End If Next i End IfNext sthWorksheets.Add after:=Worksheets(Worksheets.Count)Set sthn = ActiveSheetsthn.Name = "最终统计结果"sthn.Cells(1, 1).Resize(UBound(arr, 2), UBound(arr)) = WorksheetFunction.Transpose(arr)End Sub今天的代码似乎有点多，可能有些小伙伴们会方了，其实不用方，虽然代码多了，但是方法还是非常好理解的，我们先来看看结果。
和之前的代码不同之处在于，我们这里确定的要统计的列，是类别所在的列名，比方说我们要统计A5到A10的成绩，我们只需要在姓名列作出选择
最终结果也是仅仅就计算了这几个人的成绩，其他人的成绩并没有干扰到我们的计算
代码分析
虽然代码看起来是增加了很多，但是我觉得有了前面几节的基础之后，本节理解起来是非常的方便的，来我们看看代码
Set zd = CreateObject("scripting.dictionary")Set trng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)Set lrng = Application.InputBox("请选择要计算的列区域", "计算区域的确定", , , , , , 8)trng.SelectCountR = trng.Rows.CountFirstL = trng.ColumnSumL = lrng.Columns = Cells(CountR, FirstL)j = 0CountNum = 0 '循环的第几个工作表这一段代码实在是太熟悉了，无非就是申明一个字典类型，然后同时获取表头区域和所在列的位置而已
继续往下走
我们来说下思路
我们还是使用字典和数组的总和来实现目的，我们在统计第一个工作表的时候，我们需要循环的是我们所选择的要计算列的区域，因为是最开始，所以字典是一个空白的字典，所以如果不存在的话，我们还是利用之前学习过的数组的之后，循环填充数组
l = lrng.Rows.Count l1 = sth.Cells(2, Columns.Count).End(xlToLeft).Column For i = CountR To CountR + l k = sth.Cells(i, 1) If zd.Exists(k) Then If k <> s Then n = zd(k) arr(2, n) = arr(2, n) + sth.Cells(i, SumL) End If Else j = j + 1 zd(k) = j ReDim Preserve arr(1 To l1, 1 To j) For i1 = 1 To l1 arr(i1, j) = sth.Cells(i, i1) Next i1 End If Next i就是这一大段代码实现的效果，其实这之前我们学习过的7.36的部分代码是完全相同的，这一段就比较好理解了，我们循环之后，数组中已经有了第一个表的A5到A10的所有数据了
然后重点来了，进入第二个工作表之后，我们这里需要循环的就不再是我们所选择的列的区域了，我们需要循环的是类名所在的列，整个列都要循环，因为我们不敢保证数据是完全相同的，比方说第二个表前面5个数据则是A1~A5,并不是A5~A10
所以我们需要循环姓名这一列的所有数据，一旦找到了数据就利用字典的特性，我们之前已经赋值了，就可以找到对应的姓名在数组中的位置，针对指定的数组进行求和
l = sth.Cells(Rows.Count, 1).End(xlUp).Row l1 = sth.Cells(2, Columns.Count).End(xlToLeft).Column For i = CountR To l k = sth.Cells(i, 1) If zd.Exists(k) Then If k <> s Then n = zd(k) For i1 = 3 To l1 arr(i1, n) = arr(i1, n) + sth.Cells(i, i1) Next i1 End If End If Next i和之前的代码相比，好像少了一部分，那一部分呢？如果不存在字典中的那一部分呢？
这里我们要理解，我们需要求和的数据是字典中已经存在的数据，也就是第一个表中我们选择的A5~A10的数据，其中不在这个范围的数据，我们不需要计算的
所以这里我们只有当字典中存在这个姓名的时候，才会对数组中的相应位置进行相加，不存在的时候是跳过的
If zd.Exists(k) Then'存在才相加，不存在直接跳过，这里不用写 If k <> s Then n = zd(k) For i1 = 3 To l1 arr(i1, n) = arr(i1, n) + sth.Cells(i, i1) Next i1 End If End If然后三个表循环结束之后，就得到我们的最终结果了。
数组和字典的组合在数据求和中是比较常用的，套路虽然差不多，但是大家要在理解每一步的作用和含义的基础上作出更改，不可一味生硬的套用。