我希望获得帮助,以编辑这段有用的代码:
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:草莓是最好的浆果
C1(阵列):苹果,草莓,蓝莓,桃子,橘子
D1(输出):苹果橙草莓
答案 0 :(得分:0)
一些可以帮助您的功能:
'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