同じキーワードを続けて検索する方法【VBA入門講座#25】

サブロー

こんにちは。サブローです。

『Microsoft Excel』(以下Excel、エクセル)の中の機能としてある[VBA] について基本的な説明をしていきます。

仕事の改善や個人的な知識向上に役立ててください(^o^)

第25回目の今回は

VBAを使って、同じ条件(キーワード)で続けて検索する方法

について解説していきますので、よろしくお願いします。

これまでのVBAに関する記事は、下記のINDEXを参照してくださいね。

↓サブログ内部リンク(VBA用INDEX)↓

『FindNext』メソッドについて

Findメソッドによる検索方法では検索範囲内で一番最初(先頭)にヒットしたデータしか抽出できませんが、FindNextメソッドは、続きの検索を行うことができ、該当するデータを全て検索し続けることができます！！

構文

サンプルコード

下図のようにチーム名とその横の列にランク(まぁ強さとしましょう!)がある表があります。

F3セル(下図では"S")のランクのものを『検索結果』としてF5セルから下に結果を抽出されるコードで説明しますね。

---------------------------------------------------------------------------

Sub 連続検索()

Dim 検索範囲 As Range

'『検索範囲』をRange型の変数に設定する。

Dim 検索セル As Range

'『検索セル』をRange型の変数に設定する。

Dim 検索起点行 As Long

'『検索起点行』をLong型の変数に設定する。

Dim 結果行 As Long

'『結果行』をLong型の変数に設定する。

結果行 = Range("F5").Row

'『結果行』に結果を抽出する列番号を代入する。

Range("F5", Range("F5").End(xlDown)).Clear

'以前に抽出した結果があることを想定し、一旦データをクリアする。(F5セル～入力データの最終行まで)

Set 検索範囲 = Range("B3").CurrentRegion.Columns(2)

'『検索範囲』をB3セルを起点として2列目(C列)のアクティブな領域に設定する。

Set 検索セル = 検索範囲.Find(What:=Range("F3").Value, LookAt:=xlWhole)

'『検索セル』を検索範囲から"F3"セル(例では"S")と完全一致で検索し、ヒットしたセルを代入する。

If 検索セル Is Nothing Then

'もし『検索セル』がなかった場合は

MsgBox "該当ランクチームはありません"

'該当ランクチームはありません　とメッセージが出る。

Else

'『検索セル』があった場合は

検索起点行 = 検索セル.Row

'『検索基点行』に『検索セル』の行番号を代入する。

Do

'以下の処理を繰り返す。

Cells(結果行, 6).Value = 検索セル.Offset(0, -1).Value

'『F列の結果行』に『検索セル』の1列隣のセルの値を代入する。

Cells(結果行, 6).Borders.LineStyle = xlContinuous

'『F列の結果行』に四角の罫線を引く

結果行 = 結果行 + 1

'『結果行』を1つ増やす。

Set 検索セル = 検索範囲.FindNext(検索セル)

'『検索範囲』での検索を『検索セル』の次から検索を実行し、見つかったセルを変数『検索セル』に代入する。

Loop While 検索セル.Row <> 検索起点行

'『検索セル』の行番号が変数『検索基点行』に一致しない間は、処理を繰り返す。(検索は一巡したら『検索基点』のセルに戻る)

End If

'『If』ステートメントを終了する。

Set 検索範囲 = Nothing

'『検索範囲』の変数情報を解法する。

Set 検索セル = Nothing

'『検索セル』の変数情報を解法する。

End Sub

'終了!!

---------------------------------------------------------------------------

上記のプログラムを実行すると･････

F5セルから下方向に検索してヒットするチーム名が羅列されます。

モグゾー

それでは、今回はここまで。最後までお読みいただきありがとうございました！
下のVBA講座も是非ご覧下さい！！