Excel VBA工作薄 5.8多个工作薄合并-简易版

前景提要

之前两天因为临近放假，各种事情比较的多，暂停更新了两天，今日稍微缓解过来了，重新恢复日更。

之前我们分享了如何汇总合并多个工作薄的数据，可能因为节奏进展的太快了，有些童鞋可能觉得有点跟不上节奏，因为私下有童鞋和我说，能不能分享一个简单的工作薄汇总的案例，因为实际工作中暂时接触不到这样多样化的需求，上节的方法又有点太复杂，那么小编就趁着假期和大家分享一个简易版的工作薄汇总的方法

场景模拟

根据之前小伙伴们的要求，这里我就稍微改动下数据，将原来的合计这一列替换成为产品4

image.png

这样一来我们要处理的数据就变成了这样了，我们要做的事情也更加的简单，只需要将所有的数据汇总即可

方法分析

相对于我们之前的要求，本次的要求是降低了很多，不需要固定的字段，可以减少很多的判断和步骤，如果对于上节内容还不是很了解的童鞋，也可以先看看这篇文章的内容，然后再去回头看看上节的知识。

代码区

Sub test()

Dim pathn, sth As Workbook, rng As Range, rng1 As Range, sbook As Workbook, arrT, k&

k = 0

pathn = ThisWorkbook.Path

Set sbook = ThisWorkbook

f = Dir(pathn & "\")

Do While f <> ""

    l = Cells(Rows.Count, 1).End(xlUp).Row

    If f <> "test.xlsm" Then

        For Each sth In Workbooks

            If sth.Name = f Then

                GoTo line

            End If

        Next sth

        '=====汇总工作薄的代码======

        k = k + 1

        If k = 1 Then

            Workbooks.Open (pathn & "\" & f)

            Set rng = ActiveSheet.UsedRange

            rng.Copy sbook.Worksheets(1).Cells(1, 1)

            Else

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

                arrT = Range(Cells(1, 1), Cells(1, l1))

                Workbooks.Open (pathn & "\" & f)

                Set rng = ActiveSheet.UsedRange

                arrW = rng.Rows(1)

                l2 = UBound(arrW, 2)

                For i = 1 To l2

                    On Error Resume Next

                    Num = WorksheetFunction.Match(arrW(1, i), arrT, 0)

                    If Err.Number = 0 Then

                        rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, Num)

                        Else

                            l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

                            'sbook.Worksheets(1).Columns(l3).Insert

                            sbook.Worksheets(1).Cells(1, l3 + 1) = arrW(1, i)

                            rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3 + 1)

                            'ReDim Preserve arrT(1 To 1, 1 To l3 + 1)

                            'arrT(1, l3) = arrW(1, i)

                            'arrT(1, l3 + 1) = arrW(1, l2)

                    End If

                Next i

        End If

        '=====汇总工作薄的代码======

        ActiveWorkbook.Close True

    End If

line:

    f = Dir()

Loop

End Sub

为了能够让大家更加清楚的了解到上节的代码的作用和效果，我们这里将上节的一些关键代码注释掉，并且保留原代码，这样大家可以更加清楚的了解相对应的代码所实现的功能，可以根据自己的需要灵活的组合。

我们来看看最终的效果

image.png image.png

数据还是比较的完美的，实现了我们的要求，不管字段的先后顺序，仅仅是将所有的数据汇总，方便我们对数据后续的整理和操作。