Excel VBA 5.25一个工作簿内有多个工作表 还要规避干扰字段

一起学习，一起进步~~

上一节呢，我们学习了针对工作簿字段内容不同，顺序也不同的情况下的数据汇总的操作，在那节发表之后呢，也有一些小伙伴私信我说，上一节的代码还存在着一些问题，比方说

1.虽然我们成功的汇总了数据，但是仅仅是针对一个工作簿有一个工作表的情况下汇总的，如果一个工作簿有多个工作表，这个代码还需要在扩展下

2.虽然成功的汇总了数据，但是很明显，数据是汇总了，但是一眼看下去，并不知道数据是哪里来的，后期校对数据的话，也非常的头疼。

仔细想想，大家说的还非常有道理的，那么针对上面的两个问题呢，我们今天就来继续完善下

最终实现的效果是：

1.增加针对多工作表的汇总

2.在汇总的数据中，增加数据来源， 方便后期的校对

场景说明

OK，既然已经有了目标了，那就很好办了

直接看看怎么实现

第二点，增加数据来源非常简单，我们在最终写入数据的时候，我们在增加两列，分别写入工作簿的名称和工作表的名称即可。

第一点，针对多个工作表的数据汇总，那么就是要遍历循环工作表了。

这个是我们后面第7章的重点。

先来说下，工作表的遍历，其实和工作簿的遍历一样，都是利用for  each 循环就可以实现了。

非常的简单

那么，直接上代码吧。

代码区

Sub test24()Application.DisplayAlerts = FalseDim sth As Worksheet, sth1 As Worksheet, rng1 As Range, rng As Range, sbook As Workbook, sb As Workbook, arr, arr1, arrt()Set sbook = ThisWorkbookpathn = ThisWorkbook.PathSet sth1 = ActiveSheetSet rng1 = Application.InputBox("请选择表头区域", "表头区域的确认", , , , , , 8)arr1 = rng1len1 = UBound(arr1, 2)f = Dir(pathn & "\")Do While f <> ""l1 = Cells(Rows.Count, 1).End(xlUp).RowIf f <> "5-25.xlsm" Then    For Each sb In Workbooks            If sb.Name = f Then                GoTo line            End If        Next sb    Workbooks.Open (pathn & "\" & f)    For Each sth In ActiveWorkbook.Worksheets        sth.Activate        l = Cells(1, 1).End(xlDown).Row        With ActiveSheet.UsedRange            arr = .Rows(1)            l2 = UBound(arr, 2)             Set rng = .Find(What:="合计", LookIn:=xlValues, _                  LookAt:=xlWhole, SearchDirection:=xlPrevious)                rngRow = rng.Row        End With        If l > rngRow Then            For i = 1 To l2                On Error Resume Next                num = WorksheetFunction.Match(arr(1, i), arr1, 0)                If Err.Number = 0 Then                    ReDim Preserve arrt(1 To rngRow - 2, 1 To len1)                    For j = 1 To rngRow - 2                        arrt(j, num) = Cells(j + 1, num)                    Next j                End If            Next i            Else                 For i = 1 To l2                 On Error Resume Next                    num = WorksheetFunction.Match(arr(1, i), arr1, 0)                    If Err.Number = 0 Then                        ReDim Preserve arrt(1 To l - 1, 1 To len1)                        For j = 1 To l - 1                            arrt(j, num) = Cells(j + 1, i)                        Next j                    End If            Next i        End If        l1 = sth1.Cells(Rows.Count, 1).End(xlUp).Row        sth1.Cells(l1 + 1, 1).Resize(UBound(arrt), 1) = ActiveWorkbook.Name        sth1.Cells(l1 + 1, 2).Resize(UBound(arrt), 1) = ActiveSheet.Name        sth1.Cells(l1 + 1, 3).Resize(UBound(arrt), len1) = arrt        Erase arrt    Next sth    ActiveWorkbook.Close TrueEnd Ifline:f = Dir()Application.DisplayAlerts = TrueLoopEnd Sub

代码又增加了一些，是不是很方呢？

其实不用方，因为我讲解的思维都是循环渐进，由易而难的，所以本节的代码虽然长，但是基本上是在上一节的代码的接触上新增了一点点代码而已。并不难。

掌握方法才是最重要的

只有掌握了 方法，才可以针对现有的代码进行改动，你才知道要改动哪里，增加哪里。

其实今天就增加了上面这么短短的两部分的代码，并不负责，先来看看最终的效果。

代码解析

这样的效果应该是非常的完美了。

有了工作簿和工作表名称，这样就有了数据源，方便后期的更改和校对

同时也实现了针对多个工作表的处理。

因为大致的框架逻辑都是我们之前的框架，所以，这里我们就直接针对今天新增的部分进行讲解。

首先，我们要求非常的明确，需要针对多个工作表进行循环

工作表是什么呢？工作表和工作簿又有什么区别呢？

容我偷个懒，放个之前章节的原图

换成代码就是

工作簿：workbook

工作表：worksheet

想要遍历工作表呢。依然是我们熟悉的for each循环

for each sth in ActiveWorkbook.Worksheets

注意：

这里的ActiveWorkbook.Worksheets，后面一定要带's'，他代表的就是所有的工作表的集合。

遍历每个工作表，去寻找数据的方法，和上一节就完全一样了，代码都没有做任何的改动。

唯一不同的就是最后写入的时候，要增加工作表名称

这里我们不打乱数组的布局，直接在最后写入

其实也可以在上面的数组中写入，不过这样处理数组就比较的麻烦

这里我们保持代码的连贯性，所以选择在最后直接一次性写入，更加的方便移动

---

============================

本节课的案例源码已经上传，需要的小伙伴后台私信“5-25-W6”，希望大家多支持~~，多多关注 ~ ~

好了，明晚21:00,准时再见!

---

因为公众号没有留言功能（开的比较晚），所以建立一个线下微信群，主要为大家提供一个交流的平台，同时大家也可以提一些对公众号的意见和看法，大家一起学习，一起进步。