Excel VBA工作薄 7.12继续玩转不规则数据合并 确定首行首列的数据合并并 确定首行首列的数据合并

前景提要

上节我们分享了如果我们想要合并的数据在多个工作表上，我们可以通过手工输入标头来确定要合并的列，这样的操作就比较的灵活，但是也有弊端，就是标头输入不能错，不能少空格也不能多空格，这点大家要注意，具体的使用场景还是要根据自己的实际工作需要来选择

今天我们继续分享不规则工作表数据的合并，在7.10的时候，有小伙伴们吐槽说这样的设计不合理，比方说B班表完全没有我们想要的数据，但是依然展示出来了

在实际的操作中，这样展示效果确实很差，除了能表达这个班级没有相关的数据之外并无任何价值

那么我们在今天就来尝试下，如果我们要合并的数据在这个表中不存在，那么我们就不去合并这个表了。

场景模拟

这样的场景，我想到了一个方法，既然我们需要合并的单元格中也分为首行，首列，那么我们在合并的时候，就先确定首行，首列，然后再根据首行的其他单元格内容来判断是否需要展示首列不就可以了吗？来，看看代码

代码区

鉴于之前有小伙伴反馈，7-10的原版代码看着有点绕，不是太好理解，我今天静下心来想想了，换了一种大家更好理解的思路，不过场景依然还是有点限制，就是不能跨工作表，如果是跨工作表的大家直接使用上节的代码就可以了，自由选择表头的情况下，应该不存在字段内容都为空的情况了

Sub tsts()Dim rngh As Range, rngl As Range, sth As WorksheetSet rngh = Application.InputBox("请确定首行", "标头的确定", , , , , , 8)arr = rnghSet rngl = Application.InputBox("请确定首列", "首列的确定", , , , , , 8)s = Intersect(rngh, rngl).ValueWorksheets.Add after:=Worksheets(Worksheets.Count)ActiveSheet.Name = "汇总表"Set new_sth = ActiveSheetnew_sth.Range(Cells(1, 1), Cells(1, UBound(arr, 2))) = arrFor Each sth In Worksheets If sth.Name <> "汇总表" Then k = 0 l = new_sth.Cells(Rows.Count, 1).End(xlUp).Row arrsth = sth.UsedRange.Rows(1) For i = UBound(arr, 2) To 1 Step -1 On Error Resume Next num = WorksheetFunction.Match(arr(1, i), arrsth, 0) If Err.Number = 0 Then If arr(1, i) <> s Then k = k + 1 sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l + 1, i) Else If k > 0 Then sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l + 1, i) End If End If End If Next i End IfNext sthEnd Sub

相对于7-10的代码，本节的代码已经简化了很多，效果也更加完善，感谢提出问题的小伙伴们，促使我想到了更好的办法。~~

我们来看看效果

先确定首行，首列

因为B班学习的科目是java和C++,所以没有我们要选择的字段，所以B班的数据包括姓名，都不会出现在这份数据表中

这样才算是最终让大家满意的数据。

看来我在数据处理方面的经验还是太少了，感谢各位小伙伴们指出的不足，

代码分析

Set rngh = Application.InputBox("请确定首行", "标头的确定", , , , , , 8)arr = rnghSet rngl = Application.InputBox("请确定首列", "首列的确定", , , , , , 8)

这两段就非常简单了，通过inputbox来确定首行、首列

s = Intersect(rngh, rngl).Value

这个虽然我们之前没有分享过，但是其实也是很简单的，就是求两个单元格区间的交集的，我们来看看

第一行，第一列之间的交集，就是重合的部分，是不是就只有第一个单元格，就是姓名，所以姓名所在的这一格就是交集，我们取得他的内容就是我们最后要判断的是否要展示的内容了。

和之前最大的不同之处就是，我们这里先将我们要查找的字段放在了新建的工作表第一行

new_sth.Range(Cells(1, 1), Cells(1, UBound(arr, 2))) = arr

然后再进行判断

For Each sth In Worksheets If sth.Name <> "汇总表" Then k = 0 l = new_sth.Cells(Rows.Count, 1).End(xlUp).Row arrsth = sth.UsedRange.Rows(1) For i = UBound(arr, 2) To 1 Step -1 On Error Resume Next num = WorksheetFunction.Match(arr(1, i), arrsth, 0) If Err.Number = 0 Then If arr(1, i) <> s Then k = k + 1 sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l + 1, i) Else If k > 0 Then sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l + 1, i) End If End If End If Next i End IfNext sth

这里for循环的作用就是循环遍历所有的工作表了，

在字段查找的过程中，我们采用的是倒着查找的方式来进行的

For i = UBound(arr, 2) To 1 Step -1

如果字段存在并且字段名称不等于姓名，那么就执行复制粘贴的操作

If arr(1, i) <> s Then k = k + 1'判断是否成功找到字段 sth.UsedRange.Columns(num).Offset(1, 0).Copy new_sth.Cells(l + 1, i)

当循环到姓名这一个字段的时候，我们去判断之前我们是否有成功找到其他的字段，如有，就复制姓名，如果没有，就不复制，这个关系是通过k的值来判断的

整体代码简单很多，也方便理解很多。