Функция, которая возвращает точные совпадения строк из нескольких столбцов на основе списка слов - PullRequest
Новая
       11

Функция, которая возвращает точные совпадения строк из нескольких столбцов на основе списка слов

0 голосов
/ 05 июля 2018

Я надеялся получить помощь в редактировании этого полезного фрагмента кода: 

Function ListSearchB(text As String, wordlist As String, Optional caseSensitive As Boolean = False)
Dim strMatches As String
Dim res As Variant
Dim arrWords() As String
arrWords = Split(wordlist)
On Error Resume Next
Err.Clear
For Each word In arrWords
    If caseSensitive = False Then
        res = InStr(LCase(text), LCase(word))
    Else
        res = InStr(text, word)
    End If
    If res > 0 Then
        strMatches = strMatches & word
    End If
Next word
If Len(strMatches) <> 0 Then
    strMatches = Right(strMatches, Len(strMatches))
End If
ListSearchB = strMatches
End Function

Этот код отлично работает для того, что он делает в настоящее время. Сначала он выбирает текстовую строку для сравнения, затем выбирает массив слов, разделенных запятыми, которые он ищет, чтобы найти совпадения. Если какое-либо из слов в текстовой строке соответствует слову в массиве, оно вернет это совпадение.

Что я хочу добавить к этому, так это возможность выбрать первую ячейку с текстом, затем вторую ячейку с текстом, а затем сам массив и вернуть все совпадения из обеих выбранных ячеек, которые совпадают.

Я весь день пытался заставить его работать, но каждый раз получал ошибки.

пример будет выглядеть так:

A1: яблоки вкуснее, чем апельсины

B1: лучшая ягода - клубника

С1 (массив): яблоки, клубника, черника, персики, апельсины

D1 (выход): яблоки, апельсины, клубника

1 Ответ

0 голосов
/ 06 июля 2018

Некоторые функции, которые помогут вам: 

'To check if an element is within a specific Array, Object, Range, String, etc.
Public Function isInArray(ByVal itemSearched As Variant, ByVal aArray As Variant) As Boolean
Dim item As Variant

If VarType(aArray) >= vbArray Or VarType(aArray) = vbObject Or VarType(aArray) = vbDataObject Or TypeName(aArray) = "Range" Then
    For Each item In aArray
        If itemSearched = item Then
            isInArray = True
            Exit Function
        End If
    Next item
    isInArray = False
ElseIf VarType(aArray) = vbString Then
    isInArray = InStr(1, aArray, itemSearched, vbBinaryCompare) > 0 'Comparing character by character
Else
    On Error Resume Next
    isInArray = Not IsError(Application.Match(itemSearched, aArray, False)) 'Slow on large arrays
    Err.Clear: On Error GoTo 0
End If

End Function

'To check if a word is within a sentence-like string
Public Function isInStrArray(ByVal itemSearched As Variant, ByVal strSource As Variant) As Boolean
Dim strArr As Variant

isInStrArray = False
If VarType(itemSearched) = vbString And VarType(strSource) = vbString Then
    itemSearched = Trim(itemSearched): strSource = Trim(strSource)
    If Len(itemSearched) > 0 And Len(strSource) > 0 Then
        strArr = Split(strSource) 'Splitting at each space
        isInStrArray = isInArray(itemSearched, strArr)
        Erase strArr
    End If
End If

End Function
...