プログラムミングへの一歩（その１５）
●STEP１５ グループ分けの可能な住所録の作成
（関連付け機能のコーディング２）
長い間更新をサボってしまいました。^^;
そのせいで、ここまで何を書いてきたかを本人が忘れてしまっていたために更に更新が遅れてしまいましたが再び再開いたします。m(__)m
前回ResetDataプロシジャーを完成させました。今回はSTEP１２の中ほどにある設計を使って絞込機能について進めて行きます。設計内容は、以下のようなもでした。
”絞込ボタン”イベントプロシジャー
１．テキストボックスからユーザが入力した文字列を得る。
２．絞り込まれる範囲と絞り込み結果の置き場所を明らかにし絞込みプロシジャーを呼出す。
３．リストボックスに検索結果をセットする。
絞込みプロシジャー
１．検索範囲から１行分の比較データを得る。
２．比較データと絞込み文字列を比較し絞込み文字列が比較データの中に含まれているならば結果の格納場所に１行分のデータを転送する。
３．次の行に移る。
４．現在の処理行が検索範囲を超えていなければ１に戻る。
５．件数を呼出元のプロシジャーに返す。
それでは、以上の設計をコード化していきます。
コード化の始めのステップは、プロシジャーの名前からです。動作を考えてみると多くのデータの中からデータを摘み上げるという意味で、PickupDataという名前にします。
さらに、呼出す絞込みプロシジャーにもPickupDataFuncという名前を付けておきます。最後のFuncの部分は値を返すプロシジャー（関数）である事を示しています。
では、以下の様にUserform2の部分を右クリックして”コードの表示”を選び、編集可能な状態にします。
そこに、次のコードを書込みます。
sub PickupData（ ）
End sub
function PickupDataFunc( )
as integer
End function
下の方は、今まで宣言してきたプロシジャーとは違い値を返す関数である事を示しています。関数型のプロシジャーの宣言は次のように宣言します。
[Publiuc 又は Private] function 関数名(引数郡) as 関数の型
end function
と言う具合に宣言します。
一番初めのPublic や
Privateという修飾詞は、関数だけでなく変数や定数にも適応できる修飾詞でオブジェクト（ここでは、UserForm2オブジェクト）の外から参照できるようにするか、しないかを決定することが出来ます。
上の例の空関数プロシジャー（PickupDataFunc）や空プロシジャー（PickupData）のように省略することも可能です。省略すると暗黙にPublicと宣言されるます。従って上の２つは、外部から参照可能なプロシジャーであるといえます。
少しそれてしまいましたが元に戻ってコード化を行うと１つ目の”テキストボックスからユーザが入力した文字列を得る。”の部分にはまだ、隠れた部分があります。と言うのはテキストボックスに文字がなければ何もしないでこのイベントを終了する必要があります。従ってこの行のコーディングは以下のようになります。
sub PickupData（ ）
Dim stext as string
stext = TextBox1.Text
if len(stext) > 0 then
end if
End sub
言い忘れましたが絞込文字列が入っているのは、TextBox1ですのでその中のTextプロパティから絞込文字列を取得します。
次に、"絞り込まれる範囲と絞り込み結果の置き場所を明らかにし絞込みプロシジャーを呼出す"の部分では、まず”絞り込まれる範囲”の部分は、前回のプロシージャで初期化されたエリアが”絞り込まれる範囲”に該当し、”結果の置き場所”は、その横に絞込結果を置くことにします。
ということは転送元も転送先も同じ幅を持ち”絞り込まれる範囲”の件数は、前のResetDataと同様にTableRange関数で取り出すことが出来ますのでそれを利用します。
”絞り込まれる範囲”の位置と、”絞込結果の置き場所”は先頭のセルアドレスを文字列で渡すことに決め、以上の事柄でコーディングを付足すと以下の赤文字ようになります。
当然の事ながら、以上の場所は全て”絞込シート”内での話です。
sub PickupData（ ）
Dim stext as string
Dim l As Integer
Dim n As Integer
stext = TextBox1.Text
If len(stext) > 0 then
l =
TableRange("絞込みシート").Rows.Count
n = PickupDataFunc(stext, "A1",
"I1", l, 8)
End If
End sub
Dim l As Intger は検索件数の保持変数で Dim n As Integer の部分は検索結果の件数を入れる変数を宣言しています。
l = TableRange("絞込みシート").Rows.Count
では絞り込まれる範囲の件数を検査し変数
ｌ に格納しています。
最後に
n = PickupDataFunc(stext, "A1", "I1", l, 8)
では、絞込み関数を呼出し検索結果を n に代入します。
最後に、”リストボックスに検索結果をセットする。”では、今までのプログラムを通過してくると絞込みシートのA列〜H列に、以前の絞込み結果が I列〜P列に新たな絞込み結果が入っているはずです。従ってリストボックスに検索結果をセットするということは、
(1) 古い絞込み結果をクリアする。
(2)
新たな絞込み結果を古い検索結果の部分にコピーする。
(3)
新たな絞込み結果のコピー元をクリアする。
(4)
新たな絞込み結果のコピー先をリストボックスに反映する。
以上のステップが必要です。それをコード化すると以下の赤文字のようになります。
sub PickupData（ ）
Dim stext as string
Dim l As Integer
Dim n As Integer
'
テキストボックスから文字列を得る
stext = TextBox1.Text
' 文字列が入力されいるなら
If len(stext) > 0 then
' 絞込みシートのデータ件数を得る
l = TableRange("絞込みシート").Rows.Count
' 絞込みを行う
n = PickupDataFunc(stext, "A1",
"I1", l, 8)
' 古い絞込み結果のクリア
Worksheets("絞込みシート").Range("A1:H" & l ) =
""
' 新たな絞込み結果を古い検索結果にコピー
Worksheets("絞込みシート").Range("A1:H"
& n).value = _
Worksheets("絞込みシート").Range("I1:P"
& n).value
' 新たな絞込み結果のコピー元をクリアする
Worksheets("絞込みシート").Range("I1:P"
& n) = ""
'
新たな絞込み結果をリストボックスに反映する
ListBox1.RowSource = "絞込みシート!A1:B" &
n
End If
End sub
これでほぼ、完成ですがこのプログラムではある事象に対しての対処が出来ていません。
というのは、絞り込み結果が０（合致するデータがなかった場合）赤字のｎの部分に全て０が入ってしまうのでエラーとなってしまいます。
従って、絞込み結果が０の場合追加したコードを実行しないようにし、ユーザーに対してメッセージを表示するように以下の赤字の部分を追加します。
sub PickupData（ ）
Dim stext as string
Dim l As Integer
Dim n As Integer
'
テキストボックスから文字列を得る
stext = TextBox1.Text
' 文字列が入力されいるなら
if len(stext) > 0 then
' 絞込みシートのデータ件数を得る
l = TableRange("絞込みシート").Rows.Count
' 絞込みを行う
n = PickupDataFunc(stext, "A1",
"I1", l, 8)
if n > 0 then
' 古い絞込み結果のクリア
Worksheets("絞込みシート").Range("A1:H" & l ) =
""
' 新たな絞込み結果を古い検索結果にコピー
Worksheets("絞込みシート").Range("A1:H"
& n).value = _
Worksheets("絞込みシート").Range("I1:P"
& n).value
' 新たな絞込み結果のコピー元をクリアする
Worksheets("絞込みシート").Range("I1:P"
& n) = ""
'
新たな絞込み結果をリストボックスに反映する
ListBox1.RowSource = "絞込みシート!A1:B" &
n
Else
Msgbox
”一致するデータがありません！”
End If
End If
End sub
以上でこのプロシジャーは完成です次回はこのプロシジャーから呼出す関数を完成させます。
