Поиск 2 слова одновременно VBA Excel

Question

Может кто-нибудь помочь мне с этим кодом, сейчас я могу найти 2 слова, например: LED LIGHT. Чего я хотел бы добиться, так это сразу искать «LED LIGHT» или «LIGHT LED» независимо от того, где «LED» или «LIGHT» находятся в искомом тексте, и продолжить с остальным кодом, если оба найдены. Замена «пробела» между словами подстановочным знаком «*» действительно помогает искать «LED LIGHT» независимо от положения слов в тексте, но также не выполняет поиск в обратном «LIGHT LED». Буду признателен за любую помощь!

Dim ws As Worksheet
Dim firstWord As String
Dim secondWord As String
Dim thirdWord As String
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long

On Error GoTo Whoa

Set ws = Sheet1

firstWord = InputBox("Enter word for bullet_points", "Keyword BOX")
secondWord = InputBox("Enter word for item_name", "Keyword BOX")
thirdWord = InputBox("Enter word for product_description", "Keyword BOX")
LastRow1 = Cells(Rows.Count, 8).End(xlUp).Row + 1

If firstWord = "" Then
    ActiveSheet.Cells(LastRow1, 8).Value = "No INPUT"
Else
    ActiveSheet.Cells(LastRow1, 8).Value = firstWord
End If

LastRow2 = Cells(Rows.Count, 9).End(xlUp).Row + 1
If secondWord = "" Then
    ActiveSheet.Cells(LastRow2, 9).Value = "No INPUT"
Else
    ActiveSheet.Cells(LastRow2, 9).Value = secondWord
End If

LastRow3 = Cells(Rows.Count, 10).End(xlUp).Row + 1
If thirdWord = "" Then
    ActiveSheet.Cells(LastRow3, 10).Value = "No INPUT"
Else
    ActiveSheet.Cells(LastRow3, 10).Value = thirdWord
End If

With ws
    If firstWord <> "" Then ReplaceText ws.Range("B17:B4001"), firstWord
    If secondWord <> "" Then ReplaceText ws.Range("C17:C4001"), secondWord
    If thirdWord <> "" Then ReplaceText ws.Range("D17:D4001"), thirdWord
End With

Exit Sub

Whoa:
    msgbox Err.Description
End Sub

Private Sub ReplaceText(rng As Range, txt As String)
Dim aCell As Range
Dim bCell As Range
Dim rngFound As Range

Set aCell = rng.Find(What:=txt, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
    Set bCell = aCell
    Set rngFound = aCell

    Do
        Set aCell = rng.FindNext(After:=aCell)
        If Not aCell Is Nothing Then
            If aCell.Address = bCell.Address Then Exit Do
            Set rngFound = Union(rngFound, aCell)
        Else
            Exit Do
        End If
    Loop
End If

If Not rngFound Is Nothing Then
    rngFound.Value = "XXXXXXXXXXXXX"
End If

Answer 1

Боюсь, ваше намерение ясно только частично. Поэтому мое решение ниже состоит из двух не связанных частей. В первой части пользователь вводит 3 поисковых слова и в Sheet1 делается запись того, что было введено. Во второй части, функция с именем ReplaceText, которая искала бы ячейку, содержащую все слова, введенные пользователем. Обратите внимание, что "" будет найден в каждой ячейке. Поэтому, если пользователь вводит пробелы, они не будут влиять на поиск. То, что будет иметь эффект, так это то, что «Светодиодное освещение» будет найдено, если искать «Светодиодное освещение». Пожалуйста, имейте это в виду.

Sub Test_Replace()
    ' 010

    Dim searchWord(1 To 3) As String
    Dim Clm As Long
    Dim C As Long
    Dim i As Integer

    searchWord(1) = InputBox("Enter word for bullet_points", "Keyword BOX")
    searchWord(2) = InputBox("Enter word for item_name", "Keyword BOX")
    searchWord(3) = InputBox("Enter word for product_description", "Keyword BOX")

    Clm = 2                     ' first column to replace
    With Sheet1
        For C = 8 To 10
            i = i + 1
            If Len(searchWord(i)) = 0 Then searchWord(i) = "No INPUT"
            .Cells(.Rows.Count, C).End(xlUp).Offset(1).Value = searchWord(i)
            Clm = Clm + 1
        Next C

'        If firstWord <> "" Then ReplaceText Ws.Range("B17:B4001"), firstWord
'        If secondWord <> "" Then ReplaceText Ws.Range("C17:C4001"), secondWord
'        If thirdWord <> "" Then ReplaceText Ws.Range("D17:D4001"), thirdWord
    End With

End Sub

Private Function ReplaceText(Rng As Range, _
                             searchWord() As String) As boolean

    Dim Fnd As Range
    Dim FndVal As String
    Dim i As Integer

    Set Fnd = Rng.Find(What:=searchWord(3), LookIn:=xlValues, _
                       LookAt:=xlPart, SearchOrder:=xlByRows, _
                       SearchDirection:=xlNext, _
                       MatchCase:=False, SearchFormat:=False)
    If Not Fnd Is Nothing Then
        Do Until Fnd Is Nothing
            FndVal = Fnd.Value
            ' compare case-insensitive
            For i = 2 To 1 Step -1
                If InStr(1, FndVal, searchWord(i), vbTextCompare) = 0 Then Exit For
            Next i
            If i = 0 Then
                Set Rng = Fnd
                ReplaceText = True
                Exit Do
            End If
            Set Fnd = Rng.FindNext(Fnd)
        Loop
    End If
End Function

В первой процедуре разница между моим и вашим кодом заключается в замене ActiveSheet на Sheet1. Заметьте, что переменная Clm настроена так, чтобы проходить диапазон "B17: B4001", C и D, возможно, в l oop, но мне не удалось логически связать это.

Функция ищет третье слово первым. Если это пустое значение, поиск может занять много времени, потому что каждая ячейка в искомом диапазоне соответствует требованиям. Если searchWord (3) найден, код будет искать (2) и (1) и вернуть ячейку как результат, если найдены все три. В противном случае функция будет искать следующую предварительно определенную ячейку. Вы можете уточнить процесс квалификации, чтобы убедиться, что Delight не будет ошибочно принят за Light .

Функция возвращает True или False, в зависимости от того, найдено ли совпадение , Если ответ True, переменная Rng, переданная ему в качестве аргумента, будет содержать адрес, где было найдено совпадение. Вот вызов функции, который я использовал в своих тестах.

Private Sub TestFind()
    Dim Rng As Range
    Dim Sw() As String

    Sw = Split(" One Two Three")
    Set Rng = Range("A2:A25")
    Debug.Print ReplaceText(Rng, Sw), Rng.Address
End Sub

Если функция вернула False Rng. Адрес будет "A2: A25"