Excel VBA 7.22 数据不全的报表如何合并？我用VBA来告诉你-excel下标

前景提要(文末提供源码下载）

昨天我们大致的讲述了下数据横向合并的普通操作，相信小伙伴们并不满足于这样简单的数据合并吧，毕竟日常工作中怎么会有这么简单的数据合并呢?

日常中我们常见的数据合并应该是这样的

有一个表的数据是完全的，但是其他的表的数据则是不完整的，这样的数据表要如何汇总合并呢？

代码区

Sub twotwo()
Dim nsth As Worksheet, arr()
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set nsth = ActiveSheet
nsth.Name = "横向汇总（2）"
For Each sth In Worksheets
 If sth.Name <> nsth.Name Then
 k = k + 1
 If k = 1 Then
 l = sth.Cells(1, Columns.Count).End(xlToLeft).Column
 counts = Worksheets.Count
 ReDim Preserve arr(1 To sth.Cells(Rows.Count, 1).End(xlUp).Row, 1 To l)
 For i = 1 To sth.Cells(Rows.Count, 1).End(xlUp).Row
 For j1 = 1 To l
 arr(i, j1) = sth.Cells(i, j1)
 Next j1
 Next i
 Else
 arrt = sth.UsedRange
 l = sth.Cells(1, Columns.Count).End(xlToLeft).Column
 ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + l - 1)
 For i = 1 To UBound(arr)
 On Error Resume Next
 num = WorksheetFunction.Match(arr(i, 1), WorksheetFunction.Transpose(WorksheetFunction.Index(arrt, 0, 1)), 0)
 If Err.Number = 0 Then
 For j = 2 To l
 arr(i, UBound(arr, 2) + j - l) = sth.Cells(num, j)
 Next j
 End If
 Next i
 End If
 End If
Next sth
nsth.Cells(1, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub

整体来说并不算太难，大家要理解这个思路，来看看效果

需要的数据都全部汇总了，并且相应的字段应该缺少的数据，也补充完整了。

代码分析

首先我们通过遍历循环的方式得到了一个数组，这个数组中的数据就是第一个表格中的数据。

然后继续进入循环进入下一个工作表中，从这里开始就需要进行判断了。

首先同当前表格的使用区域复制给数组arrt,，然后对数组进行重新重组

ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + l - 1)

这里大家可能比较难理解，UBound(arr, 2)代表了二维数组的最大下标，就是列数，L代表了当前工作表的最大行数，因为第一列是参考了，不算在其中，所以-1

然后就是遍历循环的方式了， 每找到一个参考列数据的位置， 就复制给数组中对应的数组的位置，这个位置如何得到呢？

arr(i, UBound(arr, 2) + j - l) = sth.Cells(num, j)

最大下标，数据所在行这几个参数之间的关系，大家可以通过调试的方式，更好理解一些。

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

本节课的案例源码已经上传，需要的小伙伴们后台私信“7-22-8”即可，希望大家多多支持~~

说明一下，下载了源码文件之后，要放在需要合并的文件夹内才可以正常执行

好了~明晚19：00，准时再见。