前景提要
最近在讨论工作薄汇总和合并数据方面的问题，各种反馈也是比较的多，最近有小伙伴们表示他们再汇总数据的时候，并不需要将文件夹内的所有的工作薄都汇总，他们需要的是按照工作薄名字的关键自来汇总，比方说****商城，****分店这样的模式，其他的并不包含这些关键字段的工作薄就不需要汇总了，好像这样的场景比较常用在各分店，店铺统计销售量的时候使用，既然大家有需要，小编就来分享下这个问题的解法
场景模拟
我们用之前模拟过的各商城的数据来模拟下场景，假设我们需要汇总当前香港地区的产品的销量，但是香港地区的产品销量分布在两个表格中，一个是香港，一个是港台，其他的工作薄的数据和我们就没有任何的关系了，我们只需要汇总这两个工作薄的数据，那么我们来尝试下，如何实现
image.png
image.png
方法分析
从案例中来看，两个表的数据和字段并不相同，姓名不同，字段顺序和字段内容都不相同，这个我们在之前学习过了如何实现了，用数组的方法就可以了，我们今天还有一个关键点，判断工作薄的名字中是否含有关键字，在之前我们学习过判断字符串中是否含有某字符，我们可以使用like()函数来实现，那么关键字从何而来呢，当然是通过输入的方式来得到咯，inputbox()，又是我们前面学习过的知识点，那么方法都有了，我们动手吧
代码区
Sub 工作薄名字中含有关键字()
Dim arrT()
Set sbook = ActiveWorkbook
GuanJian = 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()
Loop
End With
End Sub
我们来看看最终的效果
image.png
仅仅是合并了我们需要合并的两个工作薄的数据，其他的工作薄数据并没有汇总，这样得到的数据更加的精确
