[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『あいまい検索のコードについて』(ケールちゃん)
こんにちは。あいまい検索のVBAコードについて教えてください。
ネットにてユーザーフォームを使った検索フォームを探し、
自分用に少しカスタマイズしました。
しかし、以下のコードでは、1文字目(先頭文字)からの検索しかできず、
2文字目、3文字目などからの文字も検索結果として拾いたいのです。
どのように修正すればよろしいかご教授お願いします
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
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 ("同ビル名で2件以上のデータがありますが、メーカー名・型式に違いがあります。") 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
参考のところもみながらやってみたのです。
もう少し練りますね。ごめんなさいありがとうございました。
(ケールちゃん) 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 ("同ビル名で2件以上のデータがありますが、メーカー名・型式に違いがあります。") Exit Sub End If End If Next i End With End Sub
(TAKA) 2019/01/08(火) 17:28
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.