成績表や住所録などの表の中から条件に合うデータだけ取り出して、リストアップした一覧表を作りたいって事ありませんか？
点数順や科目別に並び替えたりするには、エクセルのフィルター機能を使って行うこともできますが、リストアップする内容がいつも同じならば、ボタン一つで一瞬で男性リスト・女性リストとかできると便利です。
FindNextメソッド
下の図は、クラス生徒の成績「英語」「数学」「国語」の3教科のそれぞれの点数と3教科合計点数を表にして、合計点の評価別に名前をリストアップできるようにします。
1つの条件に合うデータを繰り返し取り出してリストアップ
フィルター機能では各項目の並び替えやリストアップしかできませんが、「合計点」の【Ａ】評価の人の名前をＬ列に取り出してリストアップします。
使うVBAコードはFindNextメソッドで、Findメソッドで設定した検索条件で連続して検索を行います。
引数「After」で設定したセルの次のセルから検索を行ってくれて、検索内容の含まれるセルをRangeオブジェクトで返してくれます。
Private Sub CommandButton1_Click()
Dim myRange As Range, meRange As Range, myAddress As String, i As Integer
Set meRange = Range(“J3:J22”)
Set myRange = meRange.Find(What:=Sheets(“test”).Range(“L2”).Value, LookIn:=xlValues)
If Not myRange Is Nothing Then
myAddress = myRange.Address
i = 3
Do
Cells(i, “L”).Value = myRange.Offset(, -8).Value
Set myRange = meRange.FindNext(After:=myRange)
i= i + 1
Loop Until myRange.Address = myAddress
Else
MsgBox”該当者がいません”
End If
End Sub
- コマンドボタン（CommandButton1）をクリックすると
- 変数myRangeとmeRangeと文字列型の変数myAddressと整数型の変数iを宣言する
- 変数meRangeに評価を検索する範囲のセルJ3～J22を指定する
- 指定したセル検索範囲変数meRangeに検索条件であるシート名【test】のセルL2と同じ値のセルを検索して、最初に見つけたセルを変数myRangeに保管する
- 変数myRangeがNothingでない場合（見つけたら）Ifステートメントを開始する
- 変数myAddressに見つけたセルを補完する
- 変数iには値を転記したい最初の行が3行目なので、i=3にします
- 以下の処理を繰り返す（Doステートメントの開始）
- i行目のL列（i,”L”)の値は見つけたセルの8列左の値（名前があるセル）を転記する
- 同じ条件で変数myRangeの次のセルから検索を開始して見つけたら変数myRangeに保管する
- 変数iに1を加える（1行下になります）
- 最初に見つけたセルと同じ値のセルを見つけるまで処理を繰り返す（探し続ける）
- 見つからなかった場合（Else）
- メッセージを表示する「該当者がいません」
- Ifステートメント終了宣言
- マクロ終了
下の図のようにコマンドボタン1回押すだけでＡ評価の人がリストアップされました。
これはあくまでも基本的な使い方なので、実際にはもう少し付け加えて、表の中から同じ検索条件で条件に合うデータだけを順に取り出しています。
例えば、上の図のように「Ａ評価」だけではなく「Ｂ評価」「Ｃ評価」も全て一括で検索して表示する場合でも使っていますし、各科目別に「Ａ評価」だけ取り出してみたりして使っています。
スポンサーリンク1つの条件を複数検索条件として条件別に転記する
先ほどのＡ評価のみ表示されている図を参考にすると、残りのＢ評価とＣ評価も一緒に表示させることができます。
もちろん同じコマンドボタンを1回だけクリックするだけで！！
簡単に言ってしまうと、15行目のEnd Ifと16行目のEnd Subの間にもう1回2行目～14行目を追加するという事です。
追加1回目がＢ評価、さらに追加2回目がＣ評価って事ですね。
そんなに難しくないでしょう？
ただし、同じ名前の変数が使えないので名前をちょっと変えれば大丈夫です。
下のコードは2回目のＢ評価を追加してみました。赤い文字のところです
Private Sub CommandButton1_Click()
Dim myRange As Range, meRange As Range, myAddress As String, i As Integer
Set meRange = Range(“J3:J22”)
Set myRange = meRange.Find(What:=Sheets(“test”).Range(“L2”).Value, LookIn:=xlValues)
If Not myRange Is Nothing Then
myAddress = myRange.Address
i = 3
Do
Cells(i, “L”).Value = myRange.Offset(, -8).Value
Set myRange = meRange.FindNext(After:=myRange)
i= i + 1
Loop Until myRange.Address = myAddress
Else
MsgBox”該当者がいません”
End If
Dim myyRange As Range, meeRange As Range, myyAddress As String, j As Integer
Set meeRange = Range(“J3:J22”)
Set myyRange = meeRange.Find(What:=Sheets(“test”).Range(“M2”).Value, LookIn:=xlValues)
If Not myyRange Is Nothing Then
myyAddress = myyRange.Address
j = 3
Do
Cells(j, “M”).Value = myyRange.Offset(, -8).Value
Set myyRange = meeRange.FindNext(After:=myyRange)
j= j + 1
Loop Until myyRange.Address = myyAddress
Else
MsgBox”該当者がいません”
End If
End Sub
追加しただけではエラーになるので、変数名を下記のように変えました。
- myRangeをmyyRange
- meRangeをmeeRange
- myAddressをmyyAddress
- iをj
4つの変数を変えました！適当な変更ですが、これで大丈夫なのです。
あとは、見つけたい評価をＢ評価に（L2をM2）に変えるだけです。
3つ目のＣ評価も今と同じように変数を適当に変更すれば大丈夫ですよ！
同じ条件で探し続けなくていいから特定の値だけ探す、そうVLOOKUP関数を使わずExcel-VBAでできないかな？
使い方覚えると応用範囲が広がります。
お時間があれば、VLOOKUP関数の代わりにエクセルVBAでやる方法もご覧くださいませ。
