Функция, которая возвращает точные совпадения строк из нескольких столбцов на основе списка слов
Я надеялся получить помощь в редактировании этого полезного фрагмента кода:
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 ответ
Некоторые функции, которые помогут вам:
'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