VBA 検索フォームの作り方

顧客情報検索フォームを作成しています

ふりがな検索であいまい検索もいけるようにはできたのですが
項目追加のやりかたがわかりません

やりたいこと

・ふりがな検索と同じように
電話番号
住所
チェックボックス3つ
を追加したい（フォームには追加してデザインは完成しています）

・チェックボックスだけの検索もできるようにしたいです
（そういうことができるのであれば）

###追記

コマンドボタン等は検索フォームには設置しておらず
エンターキーで確定された時点でリスト欄に表示するようになっています

・ふりがなをあいまい検索するとリストに該当者が現れる
さらに絞り込むためチェックボックスで絞り込む
こういう使い方がしたいです（And検索ですね）

電話番号もあいまい検索です

こちらがコードです

Private Sub UserForm_Initialize()     
    rtnNo = 0     
    Call SetListBox      
End Sub

Private Sub txtふりがな_Change()     
    Call SetListBox     
End Sub
Private Sub txt電話番号_Change()      
    Call SetListBox     
End Sub

Private Sub lst顧客リスト_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    rtnNo = Me.lst顧客リスト.Text      
    Unload Me      '← フォームを閉じる
End Sub

Private Sub SetListBox()     
    Dim wRow As Long
    Dim wLstRow As Long

    Me.lst顧客リスト.Clear      
    wLstRow = 0
    For wRow = 2 To Worksheets("顧客情報").Range("A1").CurrentRegion.Rows.Count
        If Me.txtふりがな = "" Then
            
            Me.lst顧客リスト.AddItem ""
            Me.lst顧客リスト.List(wLstRow, 0) = wRow
            Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
            wLstRow = wLstRow + 1
        Else
            If InStr(1, Worksheets("顧客情報").Cells(wRow, 2), Me.txtふりがな, vbTextCompare) > 0 Then
                
                Me.lst顧客リスト.AddItem ""
                Me.lst顧客リスト.List(wLstRow, 0) = wRow
                Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
                wLstRow = wLstRow + 1
            End If
        End If
        
    Next
End Sub

hatena19

2021/03/16 03:02

コードはマークダウンのコードブロックに入れてください。下記を参考に。 https://teratail.com/help/question-tips#questionTips3-5-1 あと、以下の点について質問に情報を追加してください。「・チェックボックスだけの検索もできるようにしたいです」とのことですが、具体的にはどのような検索がしたいのですか。これだけではなんのことか分かりません。ふりがな、電話番号、住所はそれぞれ単独で検索するのですか。つまり、ふりがなを編集したらそのふりがなだけで検索する。他のテキストボックスの値は無視する。あるいは、それぞれのテキストボックスの値を合わせて抽出条件とするのでしょうか。それぞれのテキストボックスの値をすべて満たす条件（And条件）で抽出する。また、電話番号もあいまい検索でしょうか。

cra

2021/03/16 04:37

追記完了しました　ありがとうございます

hatena19

2021/03/16 04:59

> さらに絞り込むためチェックボックスで絞り込む > こういう使い方がしたいです（And検索ですね）この辺が何をしたいのか分かりづらいです。もう少し具体的に説明してもらえませんか。

cra

2021/03/16 05:13 編集

ふりがなであいまい検索　→　リストボックスに該当者表示・該当者複数の為　絞り込みたい →チェックボックスでフリガナ検索で出てきた人のなかからまた検索という使い方とチェックボックスだけで検索 checkbox1だけチェックを入れたらそのカテゴリーの人が表示されるチェックボックスでは　このふたつをやりたいですこれでわかりますでしょうか

hatena19

2021/03/16 05:31

シートにカテゴリーの列があるということですか。チェックボックスのキャプションはカテゴリ名になっているということでしょうか。

cra

2021/03/16 05:38

シートに種類というセルがありチェックボックス3つの名前はそれぞれ違いますチェックボックスは3つなのですがセルは1つしかありません 3つのうちどれかにチェックをいれてそれをセルへ反映させています

cra

2021/03/16 05:47

Private Sub UserForm_Initialize() rtnNo = 0 Call SetListBox End Sub Private Sub txtふりがな_Change() Call SetListBox End Sub Private Sub txt電話番号_Change() Call SetListBox End Sub Private Sub lst顧客リスト_DblClick(ByVal Cancel As MSForms.ReturnBoolean) rtnNo = Me.lst顧客リスト.Text Unload Me End Sub Private Sub SetListBox() Dim wRow As Long Dim wLstRow As Long Me.lst顧客リスト.Clear wLstRow = 0 With Worksheets("顧客情報") For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count If (Me.txtふりがな = "" Or .Cells(wRow, 2) Like "*" & Me.txtふりがな & "*") _ And (Me.txt電話番号 = "" Or .Cells(wRow, 2) Like "*" & Me.txt電話番号 & "*") _ And (Me.txt住所 = "" Or .Cells(wRow, 2) Like "*" & Me.txt住所 & "*") Then Me.lst顧客リスト.AddItem "" Me.lst顧客リスト.List(wLstRow, 0) = wRow Me.lst顧客リスト.List(wLstRow, 1) = .Cells(wRow, 2) wLstRow = wLstRow + 1 End If Next End With End Sub これで動かしていますが　ふりがな以外　該当者なしになってしまいます。

hatena19

2021/03/16 05:51 編集

「シートに種類というセル」というのは一つのセルに「種類」という名前を付けたということですか。チェックボックスにチェックを入れたら、そのチェックボックスのCaptionプロパティの値をそのセルに代入したいということですか。質問の「チェックボックスだけの検索」とか、コメントの「checkbox1だけチェックを入れたらそのカテゴリーの人が表示される」という説明と矛盾しているようですが。もう少しやりたいことを整理して、具体的に説明してもらわないと理解できないです。シートの内容が分かる画像も追加してもらった方が理解しやすいですね。

hatena19

2021/03/16 05:52

回答のコードを修正してますので、そちらで試してみてください。

sinya0320

2021/03/16 05:57

例えば種類セルというか、種類列があり「営業担当」「販売担当」等が入っていてチェックボックス１をチェックすると種類列に「営業担当」が入ってる行の人が絞り込まれる。とかそんな感じでしょうか？種類セルの概要が不明なのと、チェックボックスのラベルがデフォのため、伝わらないですよ。 #背後に見える「不用品」が種類ですかね？

sinya0320

2021/03/16 05:58

更新していなかった。申し訳ない。

cra

2021/03/16 06:02

シートの画像を追加しましたセルの名前は「種類」でチェックボックスは「不用品」「害獣」「その他」です検索フォームでは　どれか一つで検索をかけたりふりがな検索から名前をしぼりこんで　さらに「不用品」だけのひとを表示したい >チェックボックスのCaptionプロパティの値をそのセルに代入したいということですか。これはちがいます　セルではなく検索フォームのなかのリストに表示してほしいです

hatena19

2021/03/16 06:12

用語は正確に使わないと他人に伝わりませんよ。例えば、「シートに種類というセル」→「シートに項目名「種類」の列がある」「3つのうちどれかにチェックをいれてそれをセルへ反映」→「チェックボックスのキャプション名と「種類」列を条件にデータをリストボックスに抽出したい」

cra

2021/03/16 06:23

＞「シートに項目名「種類」の列がある」＞「チェックボックスのキャプション名と「種類」列を条件にデータをリストボックスに抽出したい」この認識で大丈夫です

行動規範の内容に同意します

回答1件

ベストアンサー

チェックボックスのついてはよく分からないので、とりあえずはそれは無視して、回答します。

テキストボックス　txtふりがな、txt電話番号、txt住所
リストボックス lst顧客リスト

テキストボックスは空白の場合は条件から外して、それぞれの値のあいまい検索でAND条件とします。

まず、現状のSetListBox関数（ふりがなのみのあいまい検索）は下記のようにするとIf文は一つにできます。
（WithとLike演算子はコードをシンプルにするために使用してます。）

vba
1Private Sub SetListBox()
2    Dim wRow As Long
3    Dim wLstRow As Long
4
5    Me.lst顧客リスト.Clear
6    wLstRow = 0
7
8    With Worksheets("顧客情報")
9        For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count
10            If (Me.txtフリガナ = "" Or .Cells(wRow, 2) Like "*" & Me.txtフリガナ & "*") Then
11
12                Me.lst顧客リスト.AddItem ""
13                Me.lst顧客リスト.List(wLstRow, 0) = wRow
14                Me.lst顧客リスト.List(wLstRow, 1) = .Cells(wRow, 2)
15                wLstRow = wLstRow + 1
16
17            End If
18        Next
19    End With
20End Sub

それを踏まえて他の条件はAND演算子で繋げるだけです。

vba
1Private Sub SetListBox()
2    Dim wRow As Long
3    Dim wLstRow As Long
4
5    Me.lst顧客リスト.Clear
6    wLstRow = 0
7
8    With Worksheets("顧客情報")
9        For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count
10            If (Me.txtフリガナ = "" Or .Cells(wRow, 2) Like "*" & Me.txtフリガナ & "*") _
11            And (Me.txt電話番号 = "" Or .Cells(wRow, 6) Like "*" & Me.txt電話番号 & "*") _
12            And (Me.txt住所 = "" Or .Cells(wRow, 5) Like "*" & Me.txt住所 & "*") Then
13
14                Me.lst顧客リスト.AddItem ""
15                Me.lst顧客リスト.List(wLstRow, 0) = wRow
16                Me.lst顧客リスト.List(wLstRow, 1) = .Cells(wRow, 2)
17                wLstRow = wLstRow + 1
18
19            End If
20        Next
21    End With
22End Sub

.Cells(wRow, 2)
.Cells(wRow, 3)
.Cells(wRow, 4)
の列の部分はそれぞれ対応するデータの入っている列にしてください。

※追加されたシートの画像をみると、ふりがながB列、電話番号がF列、住所がE列なので、
.Cells(wRow, 2)
.Cells(wRow, 6)
.Cells(wRow, 5)
ですね。（コード修正済み）

チェックボックスで種類を絞り込むのも追加したコード。
チェックボックスはチェックが入ったものを条件に絞り込む。
複数チェックを入れると抽出されないので、チェックボックスよりオプションボタンの方がUIとしては適切。オプションボタンは一つしか選択できないので。

vba
1Private Sub CheckBox1_Click()
2    Call SetListBox
3End Sub
4
5Private Sub CheckBox2_Click()
6    Call SetListBox
7End Sub
8
9Private Sub CheckBox3_Click()
10    Call SetListBox
11End Sub
12
13Private Sub txt住所_Change()
14    Call SetListBox
15End Sub
16
17Private Sub txtふりがな_Change()
18    Call SetListBox
19End Sub
20
21Private Sub txt電話番号_Change()
22    Call SetListBox
23End Sub
24
25Private Sub lst顧客リスト_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
26
27    rtnNo = Me.lst顧客リスト.Text
28    Debug.Print rtnNo
29    Unload Me      '← フォームを閉じる
30End Sub
31
32Private Sub SetListBox()
33    Dim wRow As Long
34    Dim wLstRow As Long
35
36    Me.lst顧客リスト.Clear
37    wLstRow = 0
38
39    With Worksheets("顧客情報")
40        For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count
41            If (Me.txtフリガナ = "" Or .Cells(wRow, 2) Like "*" & Me.txtフリガナ & "*") _
42            And (Me.txt電話番号 = "" Or .Cells(wRow, 6) Like "*" & Me.txt電話番号 & "*") _
43            And (Me.txt住所 = "" Or .Cells(wRow, 5) Like "*" & Me.txt住所 & "*") _
44            And (Me.CheckBox1.Value = False Or .Cells(wRow, 10) = Me.CheckBox1.Caption) _
45            And (Me.CheckBox2.Value = False Or .Cells(wRow, 10) = Me.CheckBox2.Caption) _
46            And (Me.CheckBox3.Value = False Or .Cells(wRow, 10) = Me.CheckBox3.Caption) Then
47
48                Me.lst顧客リスト.AddItem ""
49                Me.lst顧客リスト.List(wLstRow, 0) = wRow
50                Me.lst顧客リスト.List(wLstRow, 1) = .Cells(wRow, 2)
51                wLstRow = wLstRow + 1
52
53            End If
54        Next
55    End With
56End Sub

If部分は下記の方がご希望にそうかも。

vba
1            If (Me.txtフリガナ = "" Or .Cells(wRow, 2) Like "*" & Me.txtフリガナ & "*") _
2            And (Me.txt電話番号 = "" Or .Cells(wRow, 6) Like "*" & Me.txt電話番号 & "*") _
3            And (Me.txt住所 = "" Or .Cells(wRow, 5) Like "*" & Me.txt住所 & "*") _
4            And ((Me.CheckBox1.Value = False And Me.CheckBox2.Value = False And Me.CheckBox3.Value = False) _
5            Or (Me.CheckBox1.Value And .Cells(wRow, 10) = Me.CheckBox1.Caption) _
6            Or (Me.CheckBox2.Value And .Cells(wRow, 10) = Me.CheckBox2.Caption) _
7            Or (Me.CheckBox3.Value And .Cells(wRow, 10) = Me.CheckBox3.Caption)) Then