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

Question

到目前为止附件是我的代码。我的问题是，我似乎无法让宏只将整个单词表（2）列B activecell（在单元格中包含多个单词）与表单（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

难点在于activecell包含一个句子，这个句子每次都会变化，如下例所示，但是我需要宏来匹配工作表（2）中的B列到工作表（1）中的A列的整个关键字。

有人可以让我的图片公开显示吗？

所以我会寻找能够从整个句子中的单元格B3中找到单词“charge”的代码（并让它在表单（1）的A列中找到它）。 B4中的“Hold”一词来自整个句子。这些可以改变很多，所以我不能手动将它们输入到我需要引用activecell的find函数中。

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

Answer 1

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

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