Excel VBA 7.18 Excel标头顺序不一致的多工作薄如何合并？ / 开普饭

这个也是小伙伴们在阅读了之前的文章之后提出的问题，之前我们分享了将多个规范的工作薄数据合并在一个工作表的操作的方法，本来也没有想过特殊的数据需求里面会有数据表头顺序不一致的情况，不过既然小伙伴们已经提出了这样的场景需求，那证明还是有可能会碰到的，我今天就针对这个情况在分享下我自己的解法

场景模拟

我们这里还是那之前的数据作为一个模拟参考对象

A班是标准格式

B班我们将python的成绩移动到第二列

C班我们将姓名移动到最后一列

还有其他的工作薄的顺序就不更改了，只要更改了一个工作薄的的所有的工作表的顺序，也能够代表表头顺序不同的情况了，来上代码

代码区

我们今天直接用数组的写法吧，因为小伙伴们表示数据可能会比较大，所以我们用数组吧，数组能够实现一次写入，避免了多次写入导致卡顿的情况出现

Sub test()Dim rng As Range, sth As Worksheet, arr(), book As WorkbookApplication.DisplayAlerts = FalseSet book = ActiveWorkbookSet rng = Application.InputBox("请选择要合并的列名", "表头的确定", , , , , , 8)With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then pathn = .SelectedItems(1) End IfEnd Withf = Dir(pathn & "\")Do While f <> "" Workbooks.Open pathn & "\" & f For Each sth In Worksheets l = Cells(Rows.Count, 1).End(xlUp).Row On Error Resume Next maxl = UBound(arr, 2) k = 0 For Each a In rng k = k + 1 num = a.Column ReDim Preserve arr(1 To rng.Columns.Count, 1 To maxl + l - 1) For i = 2 To l j = j + 1 arr(k, j) = sth.Cells(i, num) Next i If k <> rng.Columns.Count Then j = maxl End If Next a Next sth If ActiveWorkbook.Name <> book.Name Then ActiveWorkbook.Close False End Iff = Dir()Loopbook.Worksheets(1).Cells(2, 1).Resize(UBound(arr, 2), rng.Columns.Count) = WorksheetFunction.Transpose(arr)End Sub

来看看操作步骤

依然实现选择合适的文件夹