Excel VBA 7.22 报表横向合并,横列数据都不全!怎么办?

一起学习,一起进步~~

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

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

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

代码区

Sub twotwo()Dim nsth As Worksheet, arr()Worksheets.Add after:=Worksheets(Worksheets.Count)Set nsth = ActiveSheetnsth.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 IfNext sthnsth.Cells(1, 1).Resize(UBound(arr), UBound(arr, 2)) = arrEnd 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)

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

好了~明晚20:00,准时再见。

(0)

相关推荐