Excel VBA工作表 7.9批量合并单个工作薄字段不同的不规则工作表

前景提要

上一节我们学习了如何通过VBA来实现批量合并单个工作薄内的多个规则工作表的方法，通过上节的学习，想必大家应该已经可以轻松的应付日常工作中的这一类问题的操作了吧，不过当我正在美滋滋的时候，忽然想到，规则数据是挺好处理，但是如果碰到不规则数据呢？要知道日常工作中不规则数据是经常出现的，毕竟一千个人做报表不夸张的是说至少有一百种不同的结果，那么如果碰到不规则的数据报表，我们要如何用VBA来进行汇总呢？一起来看看场景模拟

场景模拟

我们还是拿每个班级的考试成绩来进行模拟，假设现在培训班针对学员的兴趣爱好，分成了三个班次，A班主要学习VBA和python，B班主要学习java和C++,而C班主要学习java和python，而在上周的考试中，每个班次的成绩都出来了，如果这个时候我们还想要汇总三个班级的成绩的话，就不能使用上节学习的方法了，因为字段名称完全不同

既然没有办法使用上节学习的方法，那么我们就需要另外寻找方法了，我们仔细回想下，在之前我们学习工作薄的不规则数据合并的时候，好像也碰到过这样的情况，不过那个时候我们的操作对象是工作薄，而不是工作表，那么我们能不能直接套用呢？

这个方法似乎很不错哦，稍作修改直接套用，也是VBA的惯用手法，来看看代码

代码区

Sub testadd()Dim sth As Worksheet, new_sth As Worksheet, arrWorksheets.Add after:=Worksheets(Worksheets.Count)ActiveSheet.Name = "汇总表"Set new_sth = ActiveSheetk = 0For Each sth In Worksheets If sth.Name <> "汇总表" Then If Not sth.UsedRange Is Nothing Then l = new_sth.Cells(Rows.Count, 1).End(xlUp).Row k = k + 1 If k = 1 Then sth.UsedRange.Copy new_sth.Cells(1, 1) Else l1 = Cells(1, Columns.Count).End(xlToLeft).Column arr = new_sth.UsedRange.Rows(1) arrF = sth.UsedRange.Rows(1) l2 = UBound(arrF, 2) For i = 1 To l2 On Error Resume Next Num = WorksheetFunction.Match(arrF(1, i), arr, 0) If Err.Number = 0 Then sth.UsedRange.Columns(i).Offset(1, 0).Copy new_sth.Cells(l + 1, Num) Else l3 = new_sth.Cells(1, Columns.Count).End(xlToLeft).Column new_sth.Columns(l3).Insert new_sth.Cells(1, l3) = arrF(1, i) sth.UsedRange.Columns(i).Offset(1, 0).Copy new_sth.Cells(l + 1, l3) arr = new_sth.UsedRange.Rows(1) End If Next i End If End If End IfNext sthEnd Sub

这代码一看好长啊，先来看看效果

比方说学习python的班级有两个，但是他们同时又要学习C++和VBA,而这份汇总表中，很好的将他们的成绩数据汇总在了一起，该空的数据就是空

代码分析

首先我们为了方便区分，和上节一样，还是采用了单独创建一个汇总表的方法

然后就开始进入我们的循环过程了。

这里的k作为一个计数的变量，来记录我们循环的次数，如果是第一次循环的话，不需要进行任何判断，直接全部复制，从第二次开始，开始做出判断

眼尖的小伙伴们一定能够看出来，其实和当初我们学习工作薄合并的时候，代码有几分相似，没错完全就是按照当初的思路来进行改写的，

arr = new_sth.UsedRange.Rows(1)arrF = sth.UsedRange.Rows(1)l2 = UBound(arrF, 2)For i = 1 To l2On Error Resume Next Num = WorksheetFunction.Match(arrF(1, i), arr, 0)  If Err.Number = 0 Then sth.UsedRange.Columns(i).Offset(1, 0).Copy new_sth.Cells(l + 1, Num) Else     l3 = new_sth.Cells(1, Columns.Count).End(xlToLeft).Column      new_sth.Columns(l3).Insert      new_sth.Cells(1, l3) = arrF(1, i)      sth.UsedRange.Columns(i).Offset(1, 0).Copy new_sth.Cells(l + 1, l3)      arr = new_sth.UsedRange.Rows(1)

我们来再次温习下之前的方法，这里我们需要将操作对象，更换成为工作表就可以了。

首先获得我们汇总表的工作表的标头

arr = new_sth.UsedRange.Rows(1)

然后我们在获得当前工作表的标头

arrF = sth.UsedRange.Rows(1)

然后进行遍历循环判断，如果arrF中的数据在arr这个数组中能够找到的话，证明这个字段是本身存在的，那么我们就可以直接复制了。

那么如何判断数组中是否含有某个字符呢？match方法

Num = WorksheetFunction.Match(arrF(1, i), arr, 0)

那么假设如果不存在呢？

那就插入一列，构造一个标头，然后在复制咯

l3 = new_sth.Cells(1, Columns.Count).End(xlToLeft).Column new_sth.Columns(l3).Insert new_sth.Cells(1, l3) = arrF(1, i) sth.UsedRange.Columns(i).Offset(1, 0).Copy new_sth.Cells(l + 1, l3)

最后如果更新了汇总表的标头的话，这里我们需要重新读取下汇总表的标头，更新下arr这个数组，这样我们就可以保证每次更新之后，arr这个数据都是最新的。

arr = new_sth.UsedRange.Rows(1)