Excel技术问题：按唯一列表提取数据集对应完整行记录

Excel公式解决方案 #

适用于Excel 365/2021（支持溢出数组） #

假设主数据存储在A:D列，唯一值列表在F:F列，在空白单元格（比如H1）输入以下公式：

=FILTER(A:D, ISNUMBER(MATCH(A:A, F:F, 0)), "无匹配记录")

• 原理：MATCH检查主数据第一列（假设为匹配关键字列）是否存在于唯一值列表中，ISNUMBER将匹配结果转为布尔值，FILTER据此提取所有符合条件的完整行。
• 溢出错误解决：确保公式所在单元格的下方、右侧无任何内容，FILTER会自动溢出所有匹配结果，无需手动下拉填充。

适用于旧版Excel（无FILTER函数） #

在输出区域的第一个单元格（比如H1）输入数组公式（输入后按Ctrl+Shift+Enter确认），然后下拉、右拉填充：

=IFERROR(INDEX(A:D, SMALL(IF(ISNUMBER(MATCH(A:A, F:F, 0)), ROW(A:A)-ROW(A1)+1), ROWS($1:1)), COLUMN(A:A)), "")

• 原理：用SMALL筛选出匹配行的行号，INDEX提取对应单元格内容，IFERROR避免超出匹配数量时出现错误值。

VBA宏解决方案 #

针对大数量级数据（如你提到的3116条记录），VBA效率更高且无溢出问题，操作步骤如下：

1. 按Alt+F11打开VBA编辑器
2. 插入新模块，粘贴以下代码：

Sub ExtractMatchingRows()
    Dim mainWS As Worksheet, listWS As Worksheet, outputWS As Worksheet
    Dim lastRowMain As Long, lastRowList As Long, lastRowOutput As Long
    Dim i As Long
    
    ' 按需修改工作表名称
    Set mainWS = ThisWorkbook.Worksheets("主数据集")
    Set listWS = ThisWorkbook.Worksheets("唯一值列表")
    
    ' 创建/获取输出工作表
    On Error Resume Next
    Set outputWS = ThisWorkbook.Worksheets("匹配结果")
    If Err.Number <> 0 Then
        Set outputWS = ThisWorkbook.Worksheets.Add
        outputWS.Name = "匹配结果"
    End If
    On Error GoTo 0
    
    ' 获取数据最后一行
    lastRowMain = mainWS.Cells(mainWS.Rows.Count, "A").End(xlUp).Row
    lastRowList = listWS.Cells(listWS.Rows.Count, "A").End(xlUp).Row
    
    ' 复制表头
    mainWS.Range("A1:D1").Copy outputWS.Range("A1")
    lastRowOutput = 1
    
    ' 遍历主数据，复制匹配行
    For i = 2 To lastRowMain
        If Not IsError(Application.Match(mainWS.Cells(i, "A").Value, listWS.Range("A1:A" & lastRowList), 0)) Then
            lastRowOutput = lastRowOutput + 1
            mainWS.Rows(i).Copy outputWS.Rows(lastRowOutput)
        End If
    Next i
    
    MsgBox "提取完成，共找到" & lastRowOutput - 1 & "条匹配记录"
End Sub

3. 修改代码中的工作表名称（主数据集、唯一值列表）和列范围（比如A:D是主数据的列）
4. 运行宏，匹配结果会自动生成在名为匹配结果的工作表中

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