如何使用VBA Macros在Excel跨工作表查找匹配内容并复制到目标工作表

前置准备 #

先确认你的工作簿中提前准备好3类工作表：

• 关键词表：存储待查找文本列表的工作表
• 数据源表：需要从中检索匹配内容的工作表
• 结果表：提前新建的空工作表，用于存放最终匹配结果

同时记好关键词所在列、数据源中需要匹配的列号，后续需要替换到代码参数中。

可用VBA代码 #

直接复制下方代码，修改开头的自定义参数即可使用：

Sub 批量匹配提取内容()
    ' ========== 以下参数请根据你的实际情况修改 ==========
    Const 关键词表名 As String = "Sheet1" ' 替换为你的关键词工作表名称
    Const 关键词列 As String = "A" ' 替换为关键词所在的列号，比如A、B、C
    Const 数据源表名 As String = "Sheet2" ' 替换为数据源工作表名称
    Const 数据源匹配列 As String = "B" ' 替换为数据源中需要匹配的列号
    Const 结果表名 As String = "Sheet3" ' 替换为存储结果的工作表名称
    Const 保留表头 As Boolean = True ' 数据源有表头就留True，无表头改False
    ' ========== 参数修改结束 ==========

    Dim 关键词区域 As Range, 关键词单元格 As Range
    Dim 数据源最后行 As Long, 结果表当前行 As Long
    Dim i As Long

    ' 清空结果表原有内容，避免旧数据干扰
    Sheets(结果表名).Cells.Clear

    ' 若保留表头则先复制数据源表头到结果表
    If 保留表头 = True Then
        Sheets(数据源表名).Rows(1).Copy Sheets(结果表名).Rows(1)
        结果表当前行 = 2
    Else
        结果表当前行 = 1
    End If

    ' 读取关键词表所有非空关键词
    Set 关键词区域 = Sheets(关键词表名).Range(关键词列 & "1:" & _
        Sheets(关键词表名).Cells(Rows.Count, 关键词列).End(xlUp).Row)

    ' 遍历每个关键词检索数据源
    For Each 关键词单元格 In 关键词区域
        If 关键词单元格.Value <> "" Then
            数据源最后行 = Sheets(数据源表名).Cells(Rows.Count, 数据源匹配列).End(xlUp).Row
            ' 遍历数据源逐行匹配
            For i = IIf(保留表头, 2, 1) To 数据源最后行
                If Sheets(数据源表名).Cells(i, 数据源匹配列).Value = 关键词单元格.Value Then
                    ' 匹配成功则复制整行到结果表
                    Sheets(数据源表名).Rows(i).Copy Sheets(结果表名).Rows(结果表当前行)
                    结果表当前行 = 结果表当前行 + 1
                End If
            Next i
        End If
    Next 关键词单元格

    MsgBox "匹配完成，共提取到 " & 结果表当前行 - IIf(保留表头, 2, 1) & " 条结果"
End Sub

使用步骤 #

• 打开目标Excel文件，按Alt+F11调出VBA编辑器
• 左侧工程资源管理器中右键点击你的工作簿名称，依次选择「插入」-「模块」
• 将上述代码粘贴到弹出的代码编辑窗口中，修改开头的自定义参数
• 按F5直接运行代码，运行结束后会弹出提示框展示匹配到的结果数量

常见需求调整 #

• 要实现模糊匹配（只要包含关键词就算匹配），将匹配判断行替换为：

  If InStr(1, Sheets(数据源表名).Cells(i, 数据源匹配列).Value, 关键词单元格.Value, vbTextCompare) > 0 Then
  

  该写法默认不区分字母大小写
• 数据量超过1万行时，可在代码开头加Application.ScreenUpdating = False，在MsgBox代码前加Application.ScreenUpdating = True，关闭屏幕更新大幅提升运行速度

内容的提问来源于stack exchange，提问作者fathima