根据关键词跨多个Excel工作簿查找数据

按关键词跨工作簿查找

现有多个Excel工作簿，含有同名工作表，且字段信息一致。我们要如何根据【工作表名】、【字段】以及【关键词】，在多个Excel工作簿内查找匹配的数据呢？

查找的Excel数据源

功能介绍

1.输入[查找工作表]、下拉选择[查找字段]，并输入[查找值]；

2.点击“查找”按钮，选择文件夹路径，就可以将多个Excel的相关匹配数据读取进来了；

3.点击“清除”按钮，即可将读取的全部数据删除。

VBA代码

1.查找

Function GetSelectedPath() With Application.FileDialog(msoFileDialogFolderPicker) .Title = "请选择要查找的工作簿路径" If .Show Then GetSelectedPath = .SelectedItems(1) End If End WithEnd Function

Sub 根据关键字跨工作簿查找记录() Dim selectedPath As String selectedPath = GetSelectedPath() If selectedPath = "" Then Exit Sub End If

Application.ScreenUpdating = False Application.DisplayAlerts = False '查找的关键词 Dim kw As String kw = Range("H1").Value

Dim sht As Worksheet Set sht = ActiveSheet

Dim fn As String fn = Dir(selectedPath & "\*.xls*")

'获取工作表数据的查找列号 Dim fieldColumn As Integer '选中第四行数据 Range(Range("a4"), Range("a4").End(xlToRight)).Select fieldColumn = Selection.Find(What:=Range("E1").Value, LookAt:=xlWhole).Column Dim wb As Workbook, findInSht As Worksheet Dim rn As Integer rn = 5 Do While fn <> "" Set wb = Workbooks.Open(selectedPath & "\" & fn, 0) '在哪个工作表查找 Set findInSht = wb.Sheets(sht.Range("B1").Value) Dim i As Integer '查找匹配的数据 wb.Close SaveChanges:=False fn = Dir Loop Application.ScreenUpdating = True Application.DisplayAlerts = TrueEnd Sub

2.清除

Sub 清除查找内容() Dim sht As Worksheet Set sht = ActiveSheet Dim lastRow As Integer lastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row If lastRow >= 5 Then sht.Range("5:" & lastRow).Delete Shift:=xlUp End IfEnd Sub

文件获取方式

点击屏幕下方的「赞」

和「在看」

；

>>推荐阅读<<

★★★查看更多的内容★★★