前景提要
在昨天的分享中,我们学习了如果将N个报表格式数据规则都相同的N个工作薄合并的操作,在昨天的文章发表了之后,不少的童鞋都表示这对于他们的帮助还是比较的大的,但是其中还有很多的不足,因为这样标准的数据格式很难找,在日常的工作中,更多的数据结构都是不标准,不规则的,碰到不标准的数据昨天的方法就会出现问题了,那么如果碰到这类问题,用VBA如何实现呢?
不规则不标准的概念非常的广,小编汇总了粉丝的一些常见的情况,来单独分享下具体的解决方法,我们来看看具体的场景
场景模拟
数据源呢,我就不重新构造了,还是用之前我们演练中的哪些数据源,不过在格式结构上面稍作调整,我们打开京东这个商城的销售情况记录表,和其他的产品表象对比,
我们发现虽然产品的数量都是相同的,但是产品的展示顺序是不同的,其他的报表的产品顺序都是1,2,3这样的顺序的,但是这个表就比较的特殊,在做表的时候将产品3放在了最前面,所以我们还用昨天的代码的话,就会导致数据出现,本来是产品3的数据就会统计到产品1的数据下,如果这两种产品的结算单价不同的话,最终可能会导致公司的财务数据出现不必要的亏损,那么面对这样的情况,我们要如何处理呢?
方法分析
大致的逻辑模呢,我们已经在之前写好了,我们现在需要重新操作的代码模块就是针对数据汇总这一块的,我们来看看我们要如何实现,
如果我们是手工操作的话,方法就是通过单元格的标头来判断是那种产品的数据,所以我们现在弄过VBA的话,也是相同的方式,我们先想办法获取要汇总的表格的表头字段以及总表的标头,然后进行一一对应就可以了,那么方法有了,代码呢?
代码区
Sub test()
Dim pathn, sth As Workbook, rng As Range, rng1 As Range, sbook As Workbook, arrT
pathn = ThisWorkbook.Path
Set sbook = ThisWorkbook
l1 = Cells(1, Columns.Count).End(xlToLeft).Column
arrT = Range(Cells(1, 1), Cells(1, l1))
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
Workbooks.Open (pathn & "\" & f)
'=====汇总工作薄的代码======
Set rng = ActiveSheet.UsedRange
arrW = rng.Rows(1)
l2 = UBound(arrW, 2)
For i = 1 To l2
Num = WorksheetFunction.Match(arrT(1, i), arrW, 0)
rng.Columns(Num).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, i)
Next i
'Set rng1 = rng.Offset(1, 0)
'rng1.Copy sbook.Worksheets(1).Cells(l + 1, 1)
'=====汇总工作薄的代码======
ActiveWorkbook.Close True
End If
line:
f = Dir()
Loop
End Sub
我们来看看最终的效果
我们将京东的表单数据和总表汇总的表单数据来对比下,三个产品的数据的位置都非常的正确,并且没有出现数据的遗漏,非常的完美
代码分析
小伙伴们应该已经发现,今天的代码其实就是在上节的代码的基础上继续调整优化的,我们来看看新增加的部分
l1 = Cells(1, Columns.Count).End(xlToLeft).Column
获得第一行总共有多少列,和之前获得某一列的最后的一个非空单元格是相同的方法,大家可以对比这来学习下
arrT = Range(Cells(1, 1), Cells(1, l1))
这里我们获得的是总报表数据的表头数据
arrW = rng.Rows(1)
这里我们得到的是目标报表的表头数据,为什么这里就比较的简单呢?因为我们在之前通过UsedRanged获得了当前单元格的活动区域,所以并不存在多余的单元格,可以直接用rng.Rows(1)方法获得单元格区域的第一行,即表头数据
然后我们开始进行循环遍历
通过总表,注意这里一定是总表,从目标报表中获取 总表的表头字段所以对应的行数,顺序不能乱,如何获得呢?之前我们学习过match()方法,今天正好用上了。
Num = WorksheetFunction.Match(arrT(1, i), arrW, 0)
然后有了对应的列号之后,我们就可以进行复制粘贴了。
rng.Columns(Num).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, i)
这个操作和上节的操作是一样的