Найти только целое слово, а не часть слова из Excel Workbook

Question

Я работаю из 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 и находит данное слово из первых двух столбцов.Проблема заключается в том, что найденный текст является частью слова.

Например, если поисковое слово / критерий содержит небольшую строку, например "be" или "sp", я получаю несколько ложных результатов.Мне нужна функция, чтобы перестать искать в словах и посмотреть на слово в целом на совпадение.

Я обнаружил, что это будет сделано путем добавления функции обрезки, и регулярное выражение - это то, что делает эту работу.Я не знаю, как справиться с этими функциями.

Answer 1

Найти все слово в ячейках диапазона

Поиск (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

Answer 2

цикл по всем найденным вхождениям, пока вы не встретите случай с ключевым словом как одиночное слово :

вот соответствующий фрагмент:

    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