検索用フォーム
検索用フォームは、登録されている項目内容による検索を行います。[ 目次 ]
画面を再確認
仕様確認
- ＩＤは完全一致検索です。
- 名前は部分一致検索です。
- 性別は完全一致検索です。
- 生年月日は範囲検索を行いますが、開始日付のみ、最終日付のみ入力された場合も機能させます。
- 上記4項目の複合検索は行いません。それぞれ単独の検索とします。検索の優先順位は、ＩＤ＞名前＞性別＞生年月日 です。
- 「削除データを含む」のチェックボックスを用意し、含む(もしくは含まない)条件と、上記4項目の複合検索を行います。
- 照会・更新・削除の各処理で兼用するため、次画面遷移ボタンの表示名を、処理ごとに切り替えます。 遷移先の画面も、処理ごとに切り替えます。
- 検索結果をリストボックスに表示します。
- 削除処理後に戻ったとき、削除の結果をリストボックスの表示内容に反映します。
- 更新処理後に戻ったとき、更新の結果をリストボックスの表示内容に反映します。
初期処理
- コンボボックスとリストボックスの初期設定をします。
- 選択された処理に応じて、次画面遷移ボタンの表示名を切り替えています。
Private Sub UserForm_Initialize()
'性別コンボボックスの設定
With BoxSex
.AddItem ""
.AddItem "男"
.AddItem "女"
End With
'リストボックスの設定
With ListMembers
.ColumnCount = 5
.ColumnWidths = "50;150;50;80;80"
.Font.Size = 12
.Font.Name = "ＭＳ ゴシック"
.TextAlign = fmTextAlignLeft
NowTopIndex = .TopIndex
NowListIndex = .ListIndex
End With
'選択された処理に応じて次画面遷移ボタンの表示名を切り替え
Select Case Mode
Case Mode_Ref
ButtonNaviNext.Caption = "照会"
Case Mode_Mod
ButtonNaviNext.Caption = "更新データ選択"
Case Mode_Del
ButtonNaviNext.Caption = "削除データ選択"
Case Else
ButtonNaviNext.Caption = "照会"
End Select
'次画面遷移ボタンを使用不可にする
ButtonNaviNext.Enabled = False
End Sub
- 性別コンボボックスに空白(無選択)が欲しかったので、直接固定値を入力しています。
- リストボックスの設定時に、表示先頭行・選択行設定のためのワーク項目も初期化しています。
検索ボタン クリック時
検索条件が入力されていれば、検索を行います。
Private Sub ButtonSearch_Click()
Worksheets("会員抽出").Select
Range("A2:D2").ClearContents
'入力チェック
If InputIsInvalid Then
Exit Sub
End If
'検索条件転送
TransferInput
'検索条件編集
EditCriteria
'検索
FilterMembers
'表示位置調整用ワーク項目を初期化
NowTopIndex = -1
NowListIndex = -1
'抽出会員をリストボックスにセット
UpdateListMembers
'リストボックスにフォーカスをセット
ListMembers.SetFocus
'次画面遷移ボタンを使用不可にする
ButtonNaviNext.Enabled = False
End Sub
----------------------------------------------------------------------
Private Function InputIsInvalid() As Boolean
'入力チェック
If BoxID.Value = "" And _
BoxName.Value = "" And _
BoxSex.Value = "" And _
BoxStartDate.Value = "" And _
BoxEndDate.Value = "" Then
MsgBox "検索条件を入力してください。", vbInformation, "確認"
InputIsInvalid = True
Exit Function
End If
If BoxStartDate <> "" And Not (IsDate(BoxStartDate)) Then
MsgBox "開始生年月日を確認してください。", vbExclamation, "確認"
InputIsInvalid = True
Exit Function
End If
If BoxEndDate <> "" And Not (IsDate(BoxEndDate)) Then
MsgBox "最終生年月日を確認してください。", vbExclamation, "確認"
InputIsInvalid = True
Exit Function
End If
InputIsInvalid = False
End Function
----------------------------------------------------------------------
Private Sub TransferInput()
Range("A2").Value = BoxID.Value
Range("B2").Value = BoxName.Value
Range("C2").Value = BoxSex.Value
Range("D2").Value = BoxStartDate.Value
Range("E2").Value = BoxEndDate.Value
If CheckBoxIncludeDeleted.Value = True Then
Range("F2").Value = ""
Else
Range("F2").Value = "="
End If
End Sub
- 当初は１プロシージャでコーディングしていましたが、分かりにくいので、分割しました。
- 入力チェックに引っかかったらメッセージボックスを表示し、検索処理は行いません。
- 入力チェックを通ったら、入力内容を検索条件指定エリア(A2:F2)に転記します。
-
「削除データを含む」チェックボックスについて。
チェックされていたら空白を転送し、条件を指定しません。
チェックされてない場合は "=" を転送し、削除年月日が空白のデータを抽出します。 - 条件を転送したら、その先の検索条件編集・検索を標準モジュールで処理します。
- リストボックスの表示先頭行・選択行を操作するワーク項目を初期化します。 検索によってリストボックスの中身が変わるので、初期状態を表す -1 にしています。
- 抽出された会員データをリストボックスにセットします。別プロシージャとして切り出しました。
- リストボックスにフォーカスをセットしています。
- 検索件数の表示を編集しています。
- 次画面遷移ボタンを使用不可にしています。
リストボックス更新処理
最新の検索結果を、リストボックスにセットします。
Public Sub UpdateListMembers()
'抽出会員をリストボックスにセット
'ロジックパターンA
' ListMembers.Clear
' ListMembers.List = Sheets("会員抽出").Range("A11").CurrentRegion.Value
' ListMembers.RemoveItem (0)
'ロジックパターンB
ListMembers.Clear
Dim lastRow As Integer
lastRow = Sheets("会員抽出").Range("A1048576").End(xlUp).Row
With ListMembers
Dim i As Integer
For i = 11 To lastRow
.AddItem Cells(i, 1).Value
.List(.ListCount - 1, 1) = Cells(i, 2).Value
.List(.ListCount - 1, 2) = Cells(i, 3).Value
.List(.ListCount - 1, 3) = Cells(i, 4).Value
.List(.ListCount - 1, 4) = Cells(i, 5).Value
Next
'表示先頭行を設定
If NowTopIndex <= .ListCount - 1 Then
.TopIndex = NowTopIndex
Else
.TopIndex = .ListCount - 1
NowTopIndex = .TopIndex
End If
'選択行を設定
If NowListIndex <= .ListCount - 1 Then
.ListIndex = NowListIndex
Else
.ListIndex = .ListCount - 1
NowListIndex = .ListIndex
End If
'件数ラベル編集
LabelCountFiltered.Caption = "( " & WorksheetFunction.Text(.ListCount, "###,##0") & " 件)"
End With
End Sub
- この処理は、検索するときだけではなく、遷移先(更新・削除)から戻ってくる際も呼び出されます。 そのため、 Public で宣言しています。
-
表示先頭行と選択行を設定します。
更新・削除の処理から戻ってきたとき、更新内容や削除結果を反映しつつ、選択行をそれらしくすることを意図しています。 細かくテストしていないので、ロジックにやや不安がありますが、今のところ、それらしく動いています。
検索結果のリストボックスへのセットは、コメント行になっているロジックパターンＡでも処理可能でした。 ただし、検索結果が0件の時、 ListCount が 0 になるかと思いきや、どうも 1 になっているらしく、データがないのにフォーカスが生きてしまうので断念しました。 見出し行を含めて一気に登録して、あとから見出し行だけ削除( RemoveItem )する方が、データの最終行を取得しないので効率的だし格好良いとも思ったのですが、 初めから 0 件なのと、1件登録してから削除するのとでは意味が違うらしい、ということを学びました。
リストボックス 変更時
リストボックス内のデータが選択されたので、次画面遷移ボタンを使用可にします。
Private Sub ListMembers_Change()
ButtonNaviNext.Enabled = True
End Sub
次画面遷移ボタン クリック時
選択されている処理に従って、照会・更新・削除の各処理画面に遷移します。
Private Sub ButtonNaviNext_Click()
'リストボックスのデータが選択されていたら次画面に遷移
If ListMembers.ListIndex <> -1 Then
'遷移先から戻ったときにリストボックスにフォーカスするよう予め設定
ListMembers.SetFocus
'表示先頭行・選択行をワークに保管
NowTopIndex = ListMembers.TopIndex
NowListIndex = ListMembers.ListIndex
'選択されている処理に従って次画面に遷移
Select Case Mode
Case Mode_Mod
FormMod.Show
Case Mode_Del
If ListMembers.List(ListMembers.ListIndex, 4) <> "" Then
MsgBox ListMembers.List(ListMembers.ListIndex, 0) & vbCrLf & _
ListMembers.List(ListMembers.ListIndex, 1) & vbCrLf & _
"この会員は削除済みです。", vbExclamation + vbOKOnly, "確認"
Exit Sub
End If
FormRef_Del.Show
Case Else
FormRef_Del.Show
End Select
End If
End Sub
------------------------------------------------------------
以下はモジュール先頭にあるワーク項目定義
------------------------------------------------------------
Private NowTopIndex As Integer
Private NowListIndex As Integer
- 遷移後の処理から戻ったときに、リストボックスにフォーカスが戻るようにしています。
- 遷移前のリストボックスの表示先頭行と選択行をワーク項目に保管しています。 使用しているワーク項目 NowTopIndex ・ NowListIndex を、このモジュールの先頭で定義することで、このモジュール内での使用を可能にしています。
- 削除済み会員は、再度削除できないようにしました。
閉じるボタン クリック時
検索用フォームを閉じます。
Private Sub ButtonClose_Click()
Unload Me
End Sub