行数不同的两列表格如何匹配组合？Excel非复制粘贴实现方案

需求：提取B列数据，为A列每行匹配对应内容，生成D列（匹配到的B列值）和E列（对应C列的数据），排除手动复制粘贴的方式。

一、公式实现 #

1. 适配Excel 365/2021（动态数组） #

在D2单元格输入以下公式，下拉填充即可自动匹配所有结果：

=IFERROR(INDEX($B$2:$B$10,SMALL(IF(ISNUMBER(SEARCH($B$2:$B$10,$A2)),ROW($B$2:$B$10)-ROW($B$2)+1),ROWS(D$2:D2))),"")

E列对应C列数据，只需把公式中的$B$2:$B$10替换为$C$2:$C$10：

=IFERROR(INDEX($C$2:$C$10,SMALL(IF(ISNUMBER(SEARCH($B$2:$B$10,$A2)),ROW($B$2:$B$10)-ROW($B$2)+1),ROWS(E$2:E2))),"")

2. 兼容旧版Excel（数组公式） #

在D2单元格输入公式后，按Ctrl+Shift+Enter确认（数组公式），再下拉填充：

=IFERROR(INDEX($B$2:$B$10,SMALL(IF(ISNUMBER(SEARCH($B$2:$B$10,$A$2:$A$4)),ROW($B$2:$B$10)-1),ROW(A1))),"")

E列对应公式：

=IFERROR(INDEX($C$2:$C$10,SMALL(IF(ISNUMBER(SEARCH($B$2:$B$10,$A$2:$A$4)),ROW($C$2:$C$10)-1),ROW(A1))),"")

二、VBA脚本实现 #

按Alt+F11打开VBA编辑器，插入模块后粘贴以下代码，运行宏即可自动生成数据：

Sub MatchAndGenerate()
    Dim ws As Worksheet
    Dim lastRowA As Long, lastRowB As Long, i As Long, j As Long, k As Long
    Dim arrA() As String, keyword As String
    
    Set ws = ActiveSheet
    lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastRowB = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    k = 2 ' 起始写入行
    
    For i = 2 To lastRowA
        arrA = Split(ws.Cells(i, "A").Value, ",")
        For Each keyword In arrA
            keyword = Trim(keyword)
            For j = 2 To lastRowB
                If ws.Cells(j, "B").Value = keyword Then
                    ws.Cells(k, "D") = keyword
                    ws.Cells(k, "E") = ws.Cells(j, "C")
                    k = k + 1
                    Exit For
                End If
            Next j
        Next keyword
    Next i
    MsgBox "生成完成"
End Sub

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