如何从格式不统一的海量数据中批量提取指定关键词至新列？

方法1：Excel数组公式（适合中小规模数据） #

假设源数据在A列，关键词列表在D列（示例范围D1:D100），提取结果放到B列。在B2单元格输入以下公式，完成后下拉填充：

=TEXTJOIN(", ", TRUE, IF(ISNUMBER(SEARCH(D$1:D$100, A2)), D$1:D$100, ""))

注：旧版Excel需按Ctrl+Shift+Enter以数组公式形式确认输入，公式会遍历关键词列表，自动匹配A列单元格中包含的关键词并以逗号分隔拼接。

方法2：Power Query（适合大规模/需频繁更新的数据） #

1. 将源数据和关键词列表分别导入Power Query（点击「数据」选项卡→「自表格/区域」）
2. 选中源数据的查询表，添加自定义列，输入以下公式（替换关键词列表[关键词]和[数据列]为实际列名）：

= Text.Combine(List.Select(关键词列表[关键词], each Text.Contains([数据列], _)), ", ")

3. 点击「关闭并上载」，结果会同步到Excel表格；后续数据更新时，右键查询表选择「刷新」即可重新提取关键词。

方法3：VBA脚本（灵活定制，适合复杂匹配场景） #

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

Sub ExtractKeywords()
    Dim dataRange As Range, keywordRange As Range
    Dim dataCell As Range, keywordCell As Range
    Dim result As String
    
    ' 按需修改工作表名、数据列和关键词列范围
    Set dataRange = ThisWorkbook.Sheets("Sheet1").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    Set keywordRange = ThisWorkbook.Sheets("Sheet1").Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
    
    For Each dataCell In dataRange
        result = ""
        For Each keywordCell In keywordRange
            ' vbTextCompare表示不区分大小写匹配，可改为vbBinaryCompare启用大小写敏感
            If InStr(1, dataCell.Value, keywordCell.Value, vbTextCompare) > 0 Then
                result = IIf(result <> "", result & ", ", "") & keywordCell.Value
            End If
        Next keywordCell
        dataCell.Offset(0, 1).Value = result
    Next dataCell
End Sub

修改代码中的工作表名和列范围后，运行脚本即可一键完成全列关键词提取。

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