只查找整个单词，而不是Excel Workbook中单词的一部分

Posted 2021-04-03

情况是我正在从MS Word工作，需要使用以下代码从Excel工作簿中提取数据：

Sub Birthyard()
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim SWORD As Range

Set SWORD = Selection.Paragraphs(1).Range
SWORD.MoveEnd wdCharacter, -1

On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")

If Err Then
    bstartApp = True
    Set xlapp = CreateObject("Excel.Application")
End If

On Error GoTo 0

With xlapp
    Set xlbook = .Workbooks.Open("C:\users\ibnea\Desktop\list.xlsm")
    Set RANG = xlbook.Worksheets("Sheet4").Range("A:B").Find(SWORD)

    If RANG Is Nothing Then
    MsgBox "Nothing Found in Sheet4 Range(A:B)"
    Else
        If RANG.Column = "2" Then
        COMPANY = RANG.Offset(0, -1).Value
        TICKER = RANG.Value
        MsgBox COMPANY & TICKER
        Else
        COMPANY = RANG.Value
        TICKER = RANG.Offset(0, 1).Value
        MsgBox COMPANY & TICKER
        End If

    End If


 End With
If bstartApp = True Then
    xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing

End Sub

上面的代码打开Excel工作簿，从前两列找到给定的Word。一切顺利，但问题在于找到的文字是单词的一部分，而不是整个单词。

例如，如果搜索词/条件包含一个小字符串，如“be”或“sp”，那么我会得到一些我不需要的错误结果。任何时候“be”或sp都可以在任何单词中找到，例如“best”或“speak”，它会返回结果。我需要该函数停止在结果中查找单词，而是将该单词作为整体查看匹配。

我整晚都在谷歌上发现它会通过添加一个修剪功能来完成，并且正则表达式可以完成这项工作。我不知道如何处理功能请帮忙。

答案

循环遍历所有找到的事件，直到遇到关键字为单个词的那个：

这是相关的片段：

    With xlbook.Worksheets("Sheet4").Range("A:B")
        Set RANG = .Find(what:=SWORD, lookat:=xlPart, LookIn:=xlValues)
        If Not RANG Is Nothing Then
            Dim firstAddress As String
            firstAddress = RANG.Address
            Do
                If Not IsError(Application.Match(SWORD, Split(RANG, " "), 0)) Then
                    MsgBox "found " & SWORD & " in " & RANG.Address

                    ' do what you need with RANG object


                    Exit Do
                End If
                Set RANG = .FindNext(RANG)
            Loop While RANG.Address <> firstAddress
        End If
    End With

另一答案

Find Whole Word in Cells of a Range

搜索（Find）由行，即A1，B1，A2，B2，A3，B3完成...如果您希望按列完成，请将xlByRows更改为xlByColumns（A1，A2，A3 ... B1，B2，B3 ...）。

FindWord子程序搜索包含单词（SWORD）的每个找到的单元格，以查找整个单词（SWORD）的出现。

代码

Sub Birthyard()

    Dim xlapp As Object
    Dim xlbook As Object
    Dim xlsheet As Object
    Dim SWORD As Range

    Dim vntRng As Variant
    Dim intCount As Integer
    Dim blnFound As Boolean
    Dim strFirst As String

    Set SWORD = Selection.Paragraphs(1).Range
    SWORD.MoveEnd wdCharacter, -1

    On Error Resume Next
    Set xlapp = GetObject(, "Excel.Application")

    If Err Then
        bstartApp = True
        Set xlapp = CreateObject("Excel.Application")
    End If

    On Error GoTo 0

    With xlapp

        Set xlbook = .Workbooks.Open("C:\users\ibnea\Desktop\list.xlsm")

        With xlbook.Worksheets("Sheet4").Range("A:B")
            Set RANG = .Find(SWORD, .Cells(.Rows.Count, .Columns.Count), _
                    xlValues, xlPart, xlByRows)
            If Not RANG Is Nothing Then
                GoSub FindWord
                If blnFound = False Then
                    strFirst = RANG.Address
                    Do
                        Set RANG = .FindNext(RANG)
                        Debug.Print RANG.Address
                        GoSub FindWord
                    Loop While Not blnFound = True And RANG.Address <> strFirst
                End If
            End If
            If blnFound Then
                If RANG.Column = "2" Then
                COMPANY = RANG.Offset(0, -1).Value
                TICKER = RANG.Value
                MsgBox COMPANY & TICKER
                Else
                COMPANY = RANG.Value
                TICKER = RANG.Offset(0, 1).Value
                MsgBox COMPANY & TICKER
                End If
              Else
                MsgBox "Nothing Found in Sheet4 Range(A:B)"
            End If
        End With

        If bstartApp = True Then
            .Quit
        End If

    End With

    Set xlapp = Nothing
    Set xlbook = Nothing
    Set xlsheet = Nothing

Exit Sub

FindWord:
    vntRng = Split(RANG.Value)
    For intCount = 0 To UBound(vntRng)
        If vntRng(intCount) = SWORD Then Exit For
    Next
    If intCount <= UBound(vntRng) Then
        blnFound = True
    End If
    Return

End Sub