根据单词列表从多列返回完全匹配的字符串的函数

时间:2018-07-05 20:42:03

标签: excel vba excel-vba string-matching

我希望获得帮助,以编辑这段有用的代码:

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(输出):苹果橙草莓

1 个答案:

答案 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