excel - 从文本中查找关键字列表并将它们列在 Excel 的数组中

Question

我想查找我在列中指定的关键字列表，并想查找文本是否包含这些关键字。如果是，关键字使用了多少次？

这是我想要实现的屏幕截图: https://www.dropbox.com/s/umfsf84iljdc8wh/Screenshot%202019-11-17%2023.30.29.png?dl=0

已保存列(第 1 列)中的我的列表

>  Apple, Mango, Banana

输入1:

I like Apple and mango. I bought a mango yesterday

结果 1:

["Apple - 1", "Mango -2 "]

我不想要唯一的出现频率，而是想要尽可能多的出现次数。另外我不希望它区分大小写。

我尝试了很多方法，但都失败了。

有什么想法可以实现这一目标吗？我要尝试VB吗？我正在尝试使用 Excel

Answer 1

所以我可能对此太过分了，但你可以尝试下面的方法，同时使用 @BraX 他推荐的脚本字典和我自己使用的正则表达式:

---

_{示例数据:}

---

_代码:

Sub Test()

Dim arr1 As Variant, arr2 As Variant, arr3() As Variant
Dim lr As Long, x As Long, y As Long
Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1 'Change to whatever CodeName your sheet has

    'Set global parameter of regex to true
    regex.Global = True

    'Get array of list
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr1 = .Range("A2:A" & lr).Value

    'Get array to loop through
    lr = .Cells(.Rows.Count, 2).End(xlUp).Row
    arr2 = .Range("B2:B" & lr).Value
    ReDim arr3(UBound(arr2) - 1)

    'Loop over both arrays in memory
    For y = LBound(arr2) To UBound(arr2)
        For x = LBound(arr1) To UBound(arr1)

            'Set regular expression pattern and count matches
            regex.Pattern = "\b" & LCase(arr1(x, 1)) & "\b"
            Set matches = regex.Execute(LCase(arr2(y, 1)))

            'Only add to dictionary if at least one occurence
            If matches.Count > 0 Then
                dict("""" & arr1(x, 1) & " - " & matches.Count & """") = 1
            End If

        Next x

        'Add all to a a third array and clear dictionary
        arr3(y - 1) = "[" & Join(dict.Keys, ", ") & "]"
        dict.RemoveAll

    Next y

    'If all looping is done, transpose arr3 to result target
    .Cells(2, 3).Resize(UBound(arr3) + 1, 1).Value = Application.Transpose(arr3)

End With

End Sub

---

_结果:

---

祝你好运，编码愉快 =)。