[[20190108160819]]　『あいまい検索のコードについて』（ケールちゃん）　ページの最後に飛ぶ

『あいまい検索のコードについて』（ケールちゃん）

こんにちは。あいまい検索のＶＢＡコードについて教えてください。
ネットにてユーザーフォームを使った検索フォームを探し、
自分用に少しカスタマイズしました。

しかし、以下のコードでは、１文字目（先頭文字）からの検索しかできず、
２文字目、３文字目などからの文字も検索結果として拾いたいのです。
どのように修正すればよろしいかご教授お願いします

*標準モジュール**********************

Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object)

    Dim Nagasa As Integer
    Dim i As Long
    Dim MaxRows As Long
    Dim Touseki As Object
    Dim KensakuChar As String
    Dim ListNamae As String
    Dim ListChar As String
    Dim KBanme As Integer
    Dim LBanme As Integer

    Set Touseki = Worksheets("修理報告書")
    MaxRows = Touseki.UsedRange.Rows.Count
    Nagasa = Len(Namae)

    MeNamae.ListBox1.Clear

    For i = 3 To MaxRows
        ListNamae = Touseki.Cells(i, 2)
        KBanme = 0
        LBanme = 0
        Do
            Do While Nagasa >= KBanme
                KBanme = KBanme + 1
                KensakuChar = Mid(Namae, KBanme, 1)
                If KensakuChar <> " " Then
                    Exit Do
                End If
            Loop
            Do While Nagasa >= LBanme
                LBanme = LBanme + 1
                ListChar = Mid(ListNamae, LBanme, 1)
                If ListChar <> " " Then
                    Exit Do
                End If
            Loop

            If KensakuChar = ListChar Then
                If Nagasa = KBanme Then
                    With MeNamae
                        .ListBox1.AddItem (ListNamae)
                    End With
                End If
            Else
                Exit Do
            End If
        Loop Until Nagasa <= KBanme
    Next
End Sub

*フォームのコード**********************

Dim Maxl As Long
Dim Touseki As Object

Private Sub UserForm_Initialize()

    Set Touseki = Worksheets("修理報告書")
    'Touseki.Activate
    Maxl = Touseki.UsedRange.Rows.Count
    'ListIdx = 0
    'ChangeSwitch = False

    'Call Member
    '透析条件テンプ作成
    'OptionButton1.Value = True
End Sub
Private Sub CommandButton1_Click()
    Dim Namae As String
    Dim MeNamae As Object

    Namae = TextBox1.Text
    Set MeNamae = KensakuForm
    Call 検索(Namae, MeNamae)

End Sub
Private Sub CommandButton2_Click()

    End
End Sub
Public Function Kensaku(ByVal Namae As String) As Integer
    Dim kensakuSu As Integer

    kensakuSu = 0
    For l = 1 To Maxl
        If Touseki.Cells(l, 2) = Namae Then
            kensakuSu = kensakuSu + 1
            If kensakuSu > 1 Then
                MsgBox ("同ビル名で２件以上のデータがありますが、メーカー名・型式に違いがあります。")
                Exit For
            End If
            Kensaku = l
        End If
    Next
End Function
Private Sub ListBox1_Click()
    'If ChangeSwitch = True Then
    '    保存忘れ防止装置
    'End If
    ListIdx = ListBox1.ListIndex
    Namae = ListBox1.List(ListIdx)
    l = Kensaku(ByVal Namae)

    'Call 個別へ表示(ByVal l)
    Touseki.Cells(l, 2).Activate
End Sub

長々と申し訳ございません。どうぞよろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

ちょっと見ただけであり、動かしてはいませんが、以下の部分を変更してみてはいかがでしょうか。

        If Touseki.Cells(l, 2) = Namae Then
        ↓
        If Touseki.Cells(l, 2) Like "*" & Namae & "*" Then
（???） 2019/01/08(火) 16:24

？？？さん
動かしてみましたけど、変わりませんでした！

KBanme = 0
とかこの変とか変えるのでしょうか？？

（風呂温度43度） 2019/01/08(火) 16:33

[[20110414200438]]
ご参考
（X） 2019/01/08(火) 16:59

Ｘさんありがとうございます。

参考のところもみながらやってみたのです。
もう少し練りますね。ごめんなさいありがとうございました。
（ケールちゃん） 2019/01/08(火) 17:27

やってることがよく分からないので

 TextBox1とCommandButton1だけのフォームを作って
 サンプルデータでやってみました。

 B列からTextBox1の値が含まれる文字列を探し
 それが二つ以上ならメッセージを出すコードです。

 参考になるか分かりませんが、、

 Private Sub CommandButton1_Click()
    Dim i As Long, KensakuSu As Long
    KensakuSu = 0
    With ThisWorkbook.Sheets("修理報告書")
        For i = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row
            If .Cells(i, "B") Like "*" & TextBox1 & "*" Then
                KensakuSu = KensakuSu + 1
                If KensakuSu > 1 Then
                    MsgBox ("同ビル名で２件以上のデータがありますが、メーカー名・型式に違いがあります。")
                    Exit Sub
                End If
            End If
        Next i
    End With
 End Sub

（TAKA） 2019/01/08(火) 17:28

コメント返信：

[ 一覧(最新更新順) ]

[[20190108160819]] 『あいまい検索のコードについて』（ケールちゃん） ページの最後に飛ぶ

***標準モジュール************************

***フォームのコード************************

[[20190108160819]]　『あいまい検索のコードについて』（ケールちゃん）　ページの最後に飛ぶ

*標準モジュール**********************

*フォームのコード**********************