Excel VBA中InStr的多字符串搜索

我正在检查姓名文本框是否以Mr.Mrs.Ms.等开头

我创建了一个函数，但无法比较多个字符串

这是我的密码

'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

---

将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

---

使用

ParamArray

传递要搜索的令牌列表，并循环每个令牌以查找匹配项

您可以使用

vbTextCompare

强制区分大小写

记住，以开头不同于包含

或者最好使用

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

这是我的版本。虽然它解决了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

Public Sub InString_Test（）
将WS设置为工作表
设置WS=ThisWorkbook.Sheets（“Sheet1”）
变暗rcell作为范围，rng作为范围
设置rng=WS.Range（“A1:A”&WS.UsedRange.Rows.Count）
对于rng.单元格中的每个rcell
如果InStrFunc（范围（rcell.Address），“TEST”，“CAT”），则
MsgBox“字符串位于”&rcell.Address中
如果结束
下一个rcell
端接头
函数InStrFunc（strCheck作为字符串，ParamArray anyOf（））作为布尔值
暗淡的项目一样长
对于项=0到UBound（任意项）
如果InStr（1，strCheck，anyOf（item），vbTextCompare）为0，则
InStrFunc=True
退出功能
如果结束
下一个
端函数

@Alex K.很好！我喜欢正则表达式的解决方案。但是如果我们有超过20个字符串要搜索呢？我觉得把它们都写下来是不甜蜜的。直接从盒子里拿出来。

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