Excel VBA工作薄 5.10只合并含有某关键字的工作薄 数据汇总更精确

前景提要

最近在讨论工作薄汇总和合并数据方面的问题，各种反馈也是比较的多，最近有小伙伴们表示他们再汇总数据的时候，并不需要将文件夹内的所有的工作薄都汇总，他们需要的是按照工作薄名字的关键自来汇总，比方说****商城，****分店这样的模式，其他的并不包含这些关键字段的工作薄就不需要汇总了，好像这样的场景比较常用在各分店，店铺统计销售量的时候使用，既然大家有需要，小编就来分享下这个问题的解法

场景模拟

我们用之前模拟过的各商城的数据来模拟下场景，假设我们需要汇总当前香港地区的产品的销量，但是香港地区的产品销量分布在两个表格中，一个是香港，一个是港台，其他的工作薄的数据和我们就没有任何的关系了，我们只需要汇总这两个工作薄的数据，那么我们来尝试下，如何实现

方法分析

从案例中来看，两个表的数据和字段并不相同，姓名不同，字段顺序和字段内容都不相同，这个我们在之前学习过了如何实现了，用数组的方法就可以了，我们今天还有一个关键点，判断工作薄的名字中是否含有关键字，在之前我们学习过判断字符串中是否含有某字符，我们可以使用like()函数来实现，那么关键字从何而来呢，当然是通过输入的方式来得到咯，inputbox()，又是我们前面学习过的知识点，那么方法都有了，我们动手吧

代码区

Sub 工作薄名字中含有关键字()Dim arrT()Set sbook = ActiveWorkbookGuanJian = Application.InputBox("请输入关键字", "关键字的确认", , , , , , 3)With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then pathn = .SelectedItems(1) End If f = Dir(pathn & "\") Do While f <> "" If f Like "*" & GuanJian & "*" Then l = Cells(Rows.Count, 1).End(xlUp).Row k = k + 1 If k = 1 Then Workbooks.Open (pathn & "\" & f) Set rng = ActiveSheet.UsedRange rng.Copy sbook.Worksheets(1).Cells(1, 1) Else l1 = Cells(1, Columns.Count).End(xlToLeft).Column arrT = Range(Cells(1, 1), Cells(1, l1)) Workbooks.Open (pathn & "\" & f) Set rng = ActiveSheet.UsedRange arrW = rng.Rows(1) l2 = UBound(arrW, 2) For i = 1 To l2 On Error Resume Next num = WorksheetFunction.Match(arrW(1, i), arrT, 0) If Err.Number = 0 Then rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, num) Else l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column sbook.Worksheets(1).Columns(l3).Insert sbook.Worksheets(1).Cells(1, l3) = arrW(1, i) rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3) ReDim Preserve arrT(1 To 1, 1 To l3 + 1) arrT(1, l3) = arrW(1, i) arrT(1, l3 + 1) = arrW(1, l2) End If Next i End If ActiveWorkbook.Close True End If f = Dir() LoopEnd WithEnd Sub

我们来看看最终的效果

仅仅是合并了我们需要合并的两个工作薄的数据，其他的工作薄数据并没有汇总，这样得到的数据更加的精确