Excel VBA 7.19 Excel跨工作薄多工作表数据合并之Excel表格多行表头
一起学习,一起进步~~
多行表头,表头中含有合并单元格,这种类型的Excel表格在我们的日常工作中是经常出现的,很多的人在做表格的时候,想要体现表格的整齐和美观,大批量的使用了合并单元格、多行表头的形式,虽然整体表格数据好看了很多,但是对于数据分析和数据汇总的童鞋来说,则是非常头疼的事情,小伙伴们在日常的工作中也反馈会碰到多行表头的情况,所以我们今天针对多行表头的数据汇总来分析下方法
场景模拟
假设我们要统计的Excel中每个表格都有表头,如下图
现在我们不仅仅要汇总表头,同时还需要汇总表头下面的具体的数据内容,很明显,我们之前的代码面对这样的问题的时候,就受到限制了,因为我们之前的表头都是默认只有一行的标准数据,那么眼下面对这样的情况我们要如何来解决呢?
请听我的拙见~~
代码区
既然有了多行的标有,那么我们实际操作的时候,确定有多少行表头不就行了。
来试下
Sub test()
Dim pathn, rng As Range, sth As Worksheet, book As Workbook
Set book = ActiveWorkbook
pathn = ActiveWorkbook.Path
k = 0
f = Dir(pathn & "\")
Do While f <> ""
If f <> ThisWorkbook.Name Then
k = k + 1
Workbooks.Open pathn & "\" & f
If k = 1 Then
Set rng = Application.InputBox("请选择表头区域", "标有区域的确定", , , , , , 8)
countr = rng.Rows.Count
For Each sth In Worksheets
k1 = k1 + 1
If k1 = 1 Then
sth.UsedRange.Copy book.Worksheets(1).Cells(1, 1)
Else
l = book.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
sth.UsedRange.Offset(countr, 0).Copy book.Worksheets(1).Cells(l + 1, 1)
End If
Next sth
Else
For Each sth In Worksheets
k1 = k1 + 1
If k1 = 1 Then
sth.UsedRange.Copy book.Worksheets(1).Cells(1, 1)
Else
l = book.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
sth.UsedRange.Offset(countr, 0).Copy book.Worksheets(1).Cells(l + 1, 1)
End If
Next sth
End If
ActiveWorkbook.Close False
End If
f = Dir()
Loop
End Sub
看看效果
我们首先要确定表头的区域
然后后面就交给程序自动执行了,他会根据我们选择的多行表头的行数来自行复制相关的数据区域,避免了数复制很多次表头的情况
来看看最终效果
多行表头已复制了,相关的数据也复制了,成功的将所有的数据都合并在了一个工作表
代码分析
其实本节的重点就是要获得多行表头的行数,然后我们可以从下一行将需要的正文数据复制出来,而不会将表头复制过来了。
但是因为我们手上没有工作薄的样式,是一个空的工作薄,所以再循环所有当前工作薄的文件夹的时候,我们再打开第一个个工作薄的时候,进行表头区域的确定
If k = 1 Then
Set rng = Application.InputBox("请选择表头区域", "标有区域的确定", , , , , , 8)
countr = rng.Rows.Count
k是计量单位,记录我们打开的次数,当他等于1的时候,就是代表第一次打开,然后我们就可以通过当前的这个工作薄确定表头的区域了。
如何确定有多少行呢?
countr = rng.Rows.Count'此方法进行用来确定某个单元格区域的总行数,大家可以记下写法
既然有了多行表头的总行数,那么就可以开工了。 循环所有的工作薄内的所有工作表,如果第一次循环,就将表头复制过去,如果不是第一次了,那就将跳过表头行来进行复制,就是这段代码的作用、
For Each sth In Worksheets
k1 = k1 + 1
If k1 = 1 Then
sth.UsedRange.Copy book.Worksheets(1).Cells(1, 1)
Else
l = book.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
sth.UsedRange.Offset(countr, 0).Copy book.Worksheets(1).Cells(l + 1, 1)
End If
当然上述的这些操作都是针对第一次打开第一个工作薄的操作的,如果打开后面的工作薄呢。k>1 ,则进入另外一个判断体
大家会发现这个判断体和上面的一个是完全重复的,没有,一样的思维逻辑,就是场景不同而已
===============================