Excel VBA 7.26从多个报表中提取部分数据汇总？没问题！行数不确定的？没问题！

一起学习，一起进步~~

最近有小伙伴反馈在进行工作薄数据合并的过程，碰到了一个新的问题，他们在日常的工作中经常需要将表格中的部分数据提取出来进行汇总，尤其是一些合同数据的整理，人员档案的记录， 比方说如下的情况

假设这是一份员工入职申请表，在这里有一个表格，记录的就是员工当初的高考成绩的，我们现在要做的就是从每个表格中，将这个表格提取出来并汇总在一个表格中，同时每个表中此段数据的位置不定，行数也不定

我们来尝试下用VBA实现针对这些数据的汇总要求。

代码区

因为合同等一些文件可能会涉及公司数据，所以我这里就用一个简单的入职表来替代，只要场景符合，都可以使用此方法

来看看代码

Sub test()Dim starts$, ends$, srng As Range, trng As Range, erng As Range, tsth As WorksheetSet tsth = ActiveSheetWith Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then pathn = .SelectedItems(1) End IfEnd Withstarts = Application.InputBox("请输入起始列名的表头", "开头区域的确定", , , , , , 3)ends = Application.InputBox("请输入结束列名的表头", "结尾区域的确定", , , , , , 3)f = Dir(pathn & "\")Do While f <> "" Workbooks.Open (pathn & "\" & f) For Each sth In Worksheets l = sth.UsedRange.Columns.Count l1 = tsth.Cells(Rows.Count, 1).End(xlUp).Row With sth.UsedRange Set srng = .Find(starts, , , xlWhole) If Not srng Is Nothing Then Set erng = .Find(ends, , , xlWhole) If Not erng Is Nothing Then snum = srng.Row endnum = erng.Row Set trng = srng.Resize(endnum - snum + 1, l) If l1 = 1 And tsth.Cells(1, 1) = "" Then trng.Copy tsth.Cells(1, 1) Else trng.Copy tsth.Cells(l1 + 1, 1) End If End If End If End With Next sth ActiveWorkbook.Close Falsef = Dir()LoopEnd Sub

为了更好的展示效果，我们这里将不同位置不同行数的三个表的数据做了更改，一起来看看效果

从截图可以看出来，不在同一位置的黄色字段，行数不同的三行的字段，以及标准字段180分，都应成功的复制过来了，数据并没有确实，非常的完美

代码分析

虽然需求看起来非常的复杂，但是实际上操作代码还是非常的简单的，我们假设下我们人工操作的话，是如何判断的，我们需要知道我们要找的表格的起始字段，所以我们先得到起始字段和结尾字段，

两个字段所在行中间的部分就是我们要复制的数据区域了。

Set srng = .Find(starts, , , xlWhole)

单元格位置的确定，在之前我们已经分享过了，用range.find（）方法来实现，得到了单元格之后，通过

snum = srng.Rowendnum = erng.Row

得到单元格的行数，相减就得到了我们想要的区域，我们来看看区域的范围

主要区域选择正确，那么功能就实现了。 是不是非常的简单呢？

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

赞 (0)

相关推荐