在VBA中使用InStr的多字符串搜索

Question

我正在检查姓名文本框是否以太太等开头。

我创建了一个函数，但不能比较多个字符串。

这是我的代码。

'Checking whether name is starts with Mr./Mrs./Ms./Dr. or not
If Not FindString(LCase(Me.gname.Value), LCase("Mr")) Then
    MsgBox "Consumer Name Starts with Mr./Mrs./Ms./Dr. Check Consumer Name"
    Cancel = True
    Exit Sub
End If

'Here is the Find String function i created
Function FindString(strCheck As String, strFind As String) As Boolean
    Dim intPos As Integer

    intPos = 0
    intPos = InStr(strCheck, strFind)
    FindString = intPos > 0
End Function

Answer 1

将strFind作为由定界符分隔的字符串组传递，例如：-

FindString(LCase(Me.gname.Value), LCase("Mr;Mrs;Ms;Dr"))

现在将它们拆分并使用循环进行比较。

Arr = Split(strFind,";")
Flag = 0

For Each str in Arr    
  If InStr(strCheck, str) > 0 Then
  Flag = 1    
  End If
Next
If Flag = 1 Then
  FindString = True
Else
  FindString = False
End If

Answer 2

传递令牌列表以使用ParamArray进行搜索，并循环查找所需的匹配项。

您可以使用vbTextCompare强制区分大小写。

请记住以...开头与包含不同。

'// you can pass as many prefixes as you like
If StringStarts(Me.gname.Value, "Mr", "Mrs", "Dr", "Supreme Commander", "Capt.") Then
    MsgBox "Consumer Name Starts with Mr./Mrs./Ms./Dr. Check Consumer Name"

... 

Function StringStarts(strCheck As String, ParamArray anyOf()) As Boolean
    Dim item As Long
    For item = 0 To UBound(anyOf)
        If InStr(1, strCheck, anyOf(item), vbTextCompare) = 1 Then
            StringStarts = True
            Exit Function
        End If
    Next
End Function

或更佳地使用RegEx以允许可选的.但不匹配Mruku

StringStarts(Me.gname.Value, "Mr|Mrs|Ms|Dr")

...

Function StringStarts(strCheck As String, options As String) As Boolean
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Pattern = "^(" & options & ")\.*\b"

        StringStarts = .Test(strCheck)
    End With
End Function

Answer 3

这是我的@AlexK great answer版本。当它解决了OP的原始问题时，我想分享一个更笼统的答案，以使其他人受益。

这是我使用功能的方式：

Public Sub InString_Test()

Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("Sheet1")

Dim rcell As Range, rng As Range
Set rng = WS.Range("A1:A" & WS.UsedRange.Rows.Count)
For Each rcell In rng.Cells

If InStrFunc(Range(rcell.Address), "TEST", "CAT") Then
   MsgBox "String Found in " & rcell.Address
End If

Next rcell

End Sub

Function InStrFunc(strCheck As String, ParamArray anyOf()) As Boolean
    Dim item As Long
    For item = 0 To UBound(anyOf)
        If InStr(1, strCheck, anyOf(item), vbTextCompare) <> 0 Then
            InStrFunc = True
            Exit Function
        End If
    Next
End Function