Excel 查找功能可从包含句子的活动单元格中查找整个单词，而不是单个字符

Question

附件是我到目前为止的代码。我的问题是我似乎无法让宏仅将整个单词表（2）B列活动单元格（在单元格中包含多个单词）与表（1）中的范围（A列）进行比较 - 其中是整个单词的列表（如下图所示）。代码中的其他所有内容都可以正常工作，但目前它仅适用于完全匹配？

我尝试使用通配符方法，但它似乎匹配任何字符，而我需要它来比较句子中的整个单词（在活动单元格中每次都不同）。

关于我可以添加什么以便 countif 函数找到整个单词而不是字符等的任何提示？ Find 函数也有同样的问题，它只会找到完全匹配的内容，如果没有找到，则返回错误。

    Sub FMEATest1()

Dim count As Integer
Dim count2 As Integer
Dim n As Integer
Dim m As Integer
Dim FML As Range
Dim i As Range
'Dim m As Integer
Dim a As Range
Dim b As Integer
Dim FML2 As Range
Dim WrdArray() As String
Dim k As Range
Dim j As Range
Dim Splitsentence As Range
Worksheets(1).Activate


Range(("A1"), Range("A1").End(xlDown)).Select

Set FML = Selection

Worksheets(2).Activate

Range("B3").Activate

Do Until ActiveCell.value = ""
Set i = ActiveCell
WrdArray() = Split(i, , , vbTextCompare)
Set Splitsentence = WrdArray().value

count = Application.WorksheetFunction.CountIf(FML, Splitsentence)

     'm = (ActiveCell.Row) + count - 1

    n = Selection.Rows.count

    Do Until n = (count)

     ActiveCell.Offset(1, 0).EntireRow.Insert
     Set a = Selection.Offset(1, 0)
        ActiveCell.COPY
        ActiveCell.Offset(1, 0).value = ActiveCell.value
        ActiveCell.PasteSpecial
     Range(i, a).Select

    n = Selection.Rows.count
    Loop

    'Copying Failure Modes for each Keyword
         Lookfor = ActiveCell.value & "*"
         Worksheets(1).Activate
         Cells.Find(What:=Lookfor, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Select

        Set FML2 = Selection
        Set j = ActiveCell
     count2 = Application.WorksheetFunction.CountIf(FML2, j)
     m = Selection.Rows.count
     Do Until m = (count)

    Set k = Selection.Offset(1, 0)
        Range(j, k).Select
        m = Selection.Rows.count
    Loop

    Selection.Offset(0, 1).COPY
    Worksheets(2).Activate
    ActiveCell.Offset(0, 1).PasteSpecial


    ActiveCell.Offset(n, -1).Activate

    Loop

    End Sub

困难在于活动单元格包含一个句子，并且该句子每次都不同，如下例所示，但我需要宏来匹配工作表（2）中的 B 列到工作表（1）中的 A 列的整个关键词.

请问有人可以公开我的图片吗？

所以我会寻找能够从整个句子中的单元格 B3 中找到“charge”一词的代码（并让它在 sheet(1) 的 A 列中找到它）。以及整个句子中B4中的“Hold”一词。这些变化很大，所以我不能手动将它们输入到我需要引用活动单元的查找函数中。

代码的最终解决方案应该给出以下结果（我给出了“充电”和“保持”两个示例）：

Answer 1

我假设了 cmets 中列出的数据，因此您可能需要修改工作表名称和范围。此外，根据您工作表中的其他数据，可能需要对输出进行一些调整，但如果您根据屏幕截图模拟示例，它应该可以正常工作。

Sub x()

Dim v, vOut(), i As Long, j As Long, k As Long, va, r As Range, r1 As Long

'Assumes list of words in A1/B1 and down on "Sheet1"
Set r =Sheets("Sheet1").Range("A1").CurrentRegion

With Sheets("Sheet2") 'Assumes phrases in B1 and down on "Sheet2"
    v = .Range("B1", .Range("B" & Rows.Count).End(xlUp)).Value
    .Columns(2).ClearContents
End With

ReDim vOut(1 To UBound(v) * r.Rows.Count, 1 To 2)

For i = LBound(v, 1) To UBound(v, 1)
    va = Split(v(i, 1))
    For j = LBound(va) To UBound(va)
       For r1 = 1 To r.Rows.Count
          If LCase(Application.Trim(va(j))) = LCase(r.Cells(r1, 1)) Then
             k = k + 1
             vOut(k, 1) = v(i, 1)
             vOut(k, 2) = r.Cells(r1, 2)
          End If
       Next r1
    Next j
Next i

Sheets("Sheet2").Range("B1").Resize(k, 2) = vOut 'Puts results in B1/C1 and down on "Sheet2"

End Sub