Excel - функция MATCH - несколько результатов поиска - PullRequest
0 голосов
/ 04 февраля 2020

Я пытаюсь создать инструмент Excel, который будет искать определенные c ключевые слова, расположенные на отдельном листе, и отображать результаты (полные предложения / абзацы, включая эти ключевые слова). На данный момент мне удалось отобразить только первую находку. То, что я хотел бы сделать, это отобразить все результаты друг под другом.

Я использую следующие функции: =IFERROR((INDEX(Tabulka!A:A;POZVYHLEDAT(CONCATENATE("*";FINDER!C4;"*";FINDER!C5;"*";FINDER!C6;"*";FINDER!C7;"*";FINDER!C8;"*");Tabulka!A:A;0)));"N/A")

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

На листе Табулька может быть больше предложений, включая те же самые ключевые слова, что и на листе FINDER. Я хочу, чтобы функция отображала их все друг под другом, а не только первую, как сейчас.

Можно ли как-то решить эту проблему с и / или без VBA?

Спасибо

J.

1 Ответ

0 голосов
/ 06 февраля 2020

Вот пример, который использует Регулярное выражение . Шаблон поиска строится из слов в столбце C. Результаты показаны в столбцах A и B. Столбец A имеет ссылку на ячейку.


    Sub SEARCH()

        Const COL_WORDS As String = "C"
        Const COL_RESULTS As String = "B"
        Const SHT_RESULTS As String = "FINDER"
        Const SHT_SEARCH As String = "Tabulka"

        Dim wb As Workbook, wsToSearch As Worksheet, wsResults As Worksheet
        Dim t0 As Single
        t0 = Timer

        Set wb = ThisWorkbook
        Set wsToSearch = wb.Sheets(SHT_SEARCH)
        Set wsResults = wb.Sheets(SHT_RESULTS)

        ' build array of key words without blanks
        Dim i As Integer, irow As Long, iLastRow As Long
        Dim words() As String, cell As Range

        ' last row of keywords
        iLastRow = wsResults.Range(COL_WORDS & Rows.count).End(xlUp).Row

        ReDim words(iLastRow)
        i = 0
        For Each cell In wsResults.Range(COL_WORDS & "1:" & COL_WORDS & iLastRow)
          If Len(cell) > 0 Then
            words(i) = cell.Value
            i = i + 1
          End If
        Next
        ReDim Preserve words(i - 1)

        ' build regex engine
        Dim regex As Object, sPattern As String
        sPattern = Join(words, "|")
        Debug.Print sPattern

        Set regex = CreateObject("vbscript.regexp")
        With regex
          .Global = True
          .MultiLine = True
          .Pattern = sPattern
          .IgnoreCase = True
        End With

        ' scan sheet and record results under keywords
        Dim count As Integer, matches As Integer
        count = 0: matches = 0
        irow = iLastRow + 2
        For Each cell In wsToSearch.UsedRange
           If Len(cell.Value) > 0 Then
             count = count + 1
             If regex.test(cell.Value) Then
               wsResults.Cells(irow, 1) = cell.Address
               cell.Copy wsResults.Range(COL_RESULTS & irow)
               irow = irow + 1
               matches = matches + 1
             End If
           End If
        Next

        ' format results sheet
        wsResults.Columns(COL_RESULTS).ColumnWidth = 100

         ' performance stats
        Dim sMsg As String
        sMsg = count & " cells scanned and " & matches & " matches found " _
        & " in " & Int(Timer - t0) & " seconds."
        MsgBox sMsg, vbInformation, "Result"

    End Sub
...