如何使用InStr测试更广泛的值?

时间:2017-03-24 17:19:15

标签: excel vba

我目前使用此代码搜索用户输入的特定值。但是,我想测试它是否位于字符串中的值,例如,如果用户键入“Jon”,搜索结果可能是“Jon,Jonathan,Jones”等。我想我需要以某种方式利用InStr函数,但我不确定如何设置它...任何帮助将不胜感激。

Private Sub CommandButton1_Click()
    ActiveSheet.Range("H1").Select
    Dim MyValue As String
    MyValue = TextBox1.Value
    If MyValue = "" Then
        MsgBox "Please enter a sales managers name!"
        TextBox1.SetFocus
    Else
        Application.EnableEvents = False
        Worksheets("Sheet2").Activate
        Range("A3:I200").Select
        Selection.ClearContents
        Worksheets("Sheet1").Activate
        Me.Hide
        Set i = Sheets("Sheet1")
        Set E = Sheets("Sheet2")
        Dim d
        Dim j
        d = 2
        j = 2
        Do Until IsEmpty(i.Range("A" & j))
            If i.Range("A" & j) = MyValue Then
                d = d + 1
                E.Rows(d).Value = i.Rows(j).Value
            End If
            j = j + 1
        Loop
        Application.EnableEvents = True
        Worksheets("Sheet2").Activate
        ActiveSheet.Range("H1").Select
        If Range("A3").Value = "" Then
            MsgBox "No results were found."
        Else
            MsgBox "Results were found!"
        End If
    End If
    Unload Me
End Sub

2 个答案:

答案 0 :(得分:1)

我会使用AutoFilter(),并进行一些重构,如下所示:

Private Sub CommandButton1_Click()
    Dim MyValue As String

    MyValue = Me.TextBox1.Value
    If MyValue = "" Then
        MsgBox "Please enter a sales managers name!"
        Me.TextBox1.SetFocus
    Else
        With Worksheets("Sheet1")
            With .Range("A1", .Cells(.Rows.count, 1).End(xlUp))
                .AutoFilter field:=1, Criteria1:=MyValue & "*"
                If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
                    Worksheets("Sheet2").UsedRange.ClearContents
                    Intersect(.Parent.UsedRange, .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy Worksheets("Sheet2").Range("A3")
                    MsgBox "Results were found."
                Else
                    MsgBox "No results were found."
                End If
            End With
            .AutoFilterMode = False
        End With
        Me.Hide '<--| hide the userform and move 'Unload UserformName' command to the sub that's calling the Userform
    End If        
End Sub

答案 1 :(得分:0)

您可以使用以下形式的正则表达式轻松完成此操作:

(^Jon\s)|(\sJon\s)|(\sJon$)

我将它包装在一个函数中,以允许从用户输入动态构建模式。这只是一个例子 - 除了.或(可能更好)在TextBox上添加输入限制之外,您还需要进行更多的转义。

'Add reference to Microsoft VBScript Regular Expressions
Private Function ContainsWord(target As String, search As String) As Boolean
    Const template As String = "(^<word>\s)|(\s<word>\s)|(\s<word>$)"
    Dim expression As String
    expression = Replace$(template, "<word>", Replace$(search, ".", "\."))
    With New RegExp
        .Pattern = expression
        ContainsWord = .Test(target)
    End With
End Function

样本用法:

Public Sub Example()
    Debug.Print ContainsWord("foo bar baz", "bar")  'True
    Debug.Print ContainsWord("foo barbaz", "bar")  'False
    Debug.Print ContainsWord("foobar baz", "bar")  'False
    Debug.Print ContainsWord("bar foo baz", "bar")  'True
    Debug.Print ContainsWord("foo baz bar", "bar")  'True
End Sub

在您的代码中,您只需替换该行...

If i.Range("A" & j) = MyValue Then

...与:

If ContainsWord(i.Range("A" & j).Value, MyValue) Then

请注意,由于您是在循环中调用它,因此您可能希望在您的情况下缓存RegExp,以避免在需要检查大量单元格时重复创建它。