Excel VBA工作薄 7.11 玩转不规则数据合并 字段不在同一个工作表怎么办？

前景提要(）

上一节我们学习了将单个工作薄几个字段不同的工作表的内容汇总在一个工作表的方法，在上节的操作中，我们主要是通过通过inputbox来实现工作表字段的选择的，inputbox来实现输入的话，有一个很明显的好处就是我们并不需要通过手动输入的方式来确认字段，避免了出错的可能性，但是随着使用的不断深入，我们会发现inputbox又有一个弊端，来看看

假设我现在想要将三个学科VBA，python，java都汇总在一个工作表中，但是每个表只有两个选项，如果用inputbox选择的话，没有办法实现跨表区域选择

实际上只选择了一个B班的java这一列，那么如果我们跨工作表来选择指定列的话，要如何来实现呢？

场景模拟

既然我们前面已经尝试了没有办法通过inputbox来实现跨工作表选择列的方式了，那么我们这里只能选择通过手动输入的方式来进行了，每个标头的名字中间用split函数进行分割，形成一个新的数组来替代我们之前使用过的arr，来看看代码

代码区

Sub testadd()Dim sth As Worksheet, new_sth As Worksheet, arr, rng As Range, arrsth, arrTs = Application.InputBox("请输入要合并的标头,用英文逗号隔开", "标头的确定", , , , , , 3)arr = Split(s, ",")Worksheets.Add after:=Worksheets(Worksheets.Count)ActiveSheet.Name = "汇总表"Set new_sth = ActiveSheetk = 0For Each sth In Worksheets If sth.Name <> "汇总表" Then k = k + 1 If k = 1 Then arrsth = sth.UsedRange.Rows(1) l2 = sth.Cells(Rows.Count, 1).End(xlUp).Row For i = 0 To UBound(arr) On Error Resume Next num = WorksheetFunction.Match(arr(i), arrsth, 0) If Err.Number = 0 Then l = new_sth.Cells(1, Columns.Count).End(xlToLeft).Column If l = 1 And new_sth.Cells(1, 1) = "" Then sth.UsedRange.Columns(num).Copy new_sth.Cells(1, 1) Else sth.UsedRange.Columns(num).Copy new_sth.Cells(1, l + 1) End If End If Next i Else arrsth = sth.UsedRange.Rows(1) l2 = Cells(1, Columns.Count).End(xlToLeft).Column l3 = new_sth.Cells(Rows.Count, 1).End(xlUp).Row For i = 0 To UBound(arr) On Error Resume Next num = WorksheetFunction.Match(arr(i), arrsth, 0) If Err.Number = 0 Then arrT = new_sth.Range(Cells(1, 1), Cells(1, l3)) On Error Resume Next num2 = WorksheetFunction.Match(arr(i), arrT, 0) If Err.Number <> 0 Then new_sth.Cells(1, l2 + 1) = arr(i) sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l3 + 1, l2 + 1) Else sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l3 + 1, num2) End If End If Next i End If End IfNext sthEnd Sub

我们来看看实际执行的效果

假设我们这里合并VBA，python，java这三名学科的成绩，来看看执行步骤

这里会提示我们手工输入标头，并且用英文版的逗号隔开

这里我们输入三名学科，同时加上学生的姓名

来看看最终的结果

合并是合并了，但是好像少来一个python的成绩啊，为什么呢？

我们来仔细看看python这个标头

原来每个python旁边因为输入的习惯问题，都会有一个空格，好吧，这里我们输入的没有空格，所以我们需要加上空格来看看

增加一个空格

好了效果就出来了。

代码分析

这里我们因为数据的原因，我们这里选择手工输入标头的方式来进行，大家也看到了关键点，标头一定要输对，不能少空格，多空格之类的

这里我们依然用inputbox来实现输入，相对于上节inputbox就不能直接选择单元格了，只能输入指定的标头名称，并用英文逗号隔开，

然后我们就可以用split（）函数来进行拆分，形成一个新的数组，代替上节课的rng,赋值给arr

后面的裸机就和上节的基本一样了，不过需要稍微修改下，因为我们此时的arr是一个一维数组，所以最大下标这里就需要做出变动

For i = 0 To UBound(arr)

同时进行二次判断的时候，也需要在逻辑上稍微调整下

比方说这一段

If Err.Number <> 0 Then new_sth.Cells(1, l2 + 1) = arr(i) sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l3 + 1, l2 + 1) Else sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l3 + 1, num2) End If

如果标头在汇总表中不存在的话，我们这里就需要在最右侧新增标头了，而不能向上节一样，直接利用数组的定位来进行中增加了。

l2 = Cells(1, Columns.Count).End(xlToLeft).Column

后面的逻辑基本上和上节一样，大家自己调试下就可以了。

致力于分享VBA知识，坚持原创，喜欢的小伙伴可以加个关注哦~