按指定关键词，一键汇总Excel分表数据
有时候，我们有多个EXCEl工作表，要汇总各分表中相同的关键词，手工汇总费力又会遗漏，如何实现按指定关键词，一键汇总Excel分表数据。
动画视频VBA代码如下：
Sub collect()
Dim sht As Worksheet, rng As Range, k&, trow&
Application.ScreenUpdating = False
'取消屏幕更新，加快代码运行速度
temp = InputBox("请输入需要合并的工作表所包含的关键词：", "提醒")
If StrPtr(temp) = 0 Then Exit Sub
'如果点击了inputbox的取消或者关闭按钮，则退出程序
trow = Val(InputBox("请输入标题的行数", "提醒"))
If trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
'取得用户输入的标题行数，如果为负数，退出程序
Cells.ClearContents
'清空当前表数据
For Each sht In Worksheets
'循环读取表格
If sht.Name <> ActiveSheet.Name Then
'如果表格名称不等于当前表名则……
If InStr(1, sht.Name, temp, vbTextCompare) Then
'如果表中包含关键词则进行汇总动作(不区分关键词字母大小写）
Set rng = sht.UsedRange
'定义rng为表格已用区域
k = k 1
'累计K值
If k = 1 Then
'如果是首个表格，则K为1，则把标题行一起复制到汇总表
rng.Copy
.PasteSpecial Paste:=xlPasteValues
Else
'否则，扣除标题行后再复制黏贴到总表，只黏贴数值
rng.Offset(trow).Copy
Cells(ActiveSheet.UsedRange.Rows.Count 1, 1).PasteSpecial Paste:=xlPasteValues
End If
End If
End If
Next
.Activate
'激活A1单元格
Application.ScreenUpdating = True
'恢复屏幕刷新
End Sub
页:
[1]