在文本段落中查找关键字（在 Excel 中）

Question

编辑：所有答案都很好，但对于大型数据集，宏方法效果更好。尝试所有这些，看看什么最适合你。

我正在尝试在 Excel 中解决这个问题以提高性能（我已经在 R 中完成了，但速度很慢）。基本上，我需要将每个关键字（来自关键字列表）与列中的文本（基本上是段落）进行匹配。这是一个插图：

以上数据均在本题出处，文字形式，适合复制粘贴。

我一直在寻找一些文本函数（如 FIND 和 SEARCH，但它们只返回位置），所以我不确定这是否可以在 Excel 中完成。

Answer 1

试试这个简短的宏：

Sub KeyWord()
    Dim Na As Long, Nc As Long, ary, s As String
    Dim r As Range, a, i As Long, outpt As String

    Na = Cells(Rows.Count, "A").End(xlUp).Row
    Nc = Cells(Rows.Count, "C").End(xlUp).Row

    ReDim ary(1 To Nc)
    i = 1
    For Each r In Range("C1:C" & Nc)
        ary(i) = r.Text
        i = i + 1
    Next r

    For i = 1 To Na
        s = Cells(i, "A").Value
        outpt = ""
        For Each a In ary
            If InStr(1, s, a) > 0 Then
                outpt = outpt & "," & a
            End If
        Next a
        If outpt = "" Then
        Else
            Cells(i, "E").Value = Mid(outpt, 2)
        End If
    Next i

End Sub

例如：

编辑#1：

我们仅捕获完整单词的小技巧是用空格包围每个关键字，并用空格包围每个句子。

这意味着[space] the [space]将与Theater不匹配！：

Sub KeyWord_II_TheSequel()
    Dim Na As Long, Nc As Long, ary, s As String
    Dim r As Range, a, i As Long, outpt As String

    Na = Cells(Rows.Count, "A").End(xlUp).Row
    Nc = Cells(Rows.Count, "C").End(xlUp).Row

    ReDim ary(1 To Nc)
    i = 1
    For Each r In Range("C1:C" & Nc)
        ary(i) = r.Text
        ary(i) = " " & ary(i) & " "
        i = i + 1
    Next r

    For i = 1 To Na
        s = Cells(i, "A").Value
        s = " " & s & " "
        outpt = ""
        For Each a In ary
            If InStr(1, s, a) > 0 Then
                outpt = outpt & "," & a
            End If
        Next a
        If outpt = "" Then
        Else
            Cells(i, "E").Value = Mid(outpt, 2)
        End If
    Next i

End Sub