InStrを使用してより広い値をテストするにはどうすればよいですか？

Question

私は現在、このコードを使用して、ユーザーが入力した特定の値を検索しています。しかし、私はそれが文字列内にある場合、たとえば、ユーザーが "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 

Answer 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 

Answer 2

あなたが何かの形で正規表現でかなり簡単にこれを行うことができます

：

(^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をキャッシュすることをお勧めします。