Excel VBA 7.22 报表横向合并,横列数据都不全!怎么办?
一起学习,一起进步~~
昨天我们大致的讲述了下数据横向合并的普通操作,相信小伙伴们并不满足于这样简单的数据合并吧,毕竟日常工作中怎么会有这么简单的数据合并呢?
日常中我们常见的数据合并应该是这样的
有一个表的数据是完全的,但是其他的表的数据则是不完整的,这样的数据表要如何汇总合并呢?
代码区
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)
最大下标,数据所在行这几个参数之间的关系,大家可以通过调试的方式,更好理解一些。
好了~明晚20:00,准时再见。
赞 (0)