はじめに
Excelの表から「品名が指定値と一致する行だけを抜き出し、別シートへ一覧にしたい」という場面があります。件数が少なければフィルターでも対応できますが、同じ処理を繰り返すならVBAで自動化すると便利です。
この記事では、1つの検索条件に一致する複数行を抽出し、別シートへまとめて出力する方法を解説します。固定件数の配列を使わず、実際の一致件数に合わせて結果用の配列を確保するため、データ行数が変わっても扱いやすい形にします。
VBAそのものの役割やマクロとの関係から確認したい場合は、Excel VBAとは？マクロとの関係とできることをわかりやすく解説も参考にしてください。
今回作る処理の前提
元データは「データ」シートのB列からF列にあり、4行目からデータが始まるものとします。列の内容は、B列がNo、C列が購入日、D列がメーカー、E列が品名、F列が価格です。
検索条件は「検索条件」シートのB4セルへ入力し、条件に一致した行をB8セルから下へ出力します。この記事では「品名が一致すること」を1つの条件として扱い、文字列は完全一致で判定します。
条件に一致した行全体ではなく、1つの値だけを返す処理を確認したい場合は、【Excel】ＶＢＡで特定項目の抽出方法をコードで解説で役割を分けて解説しています。
VBAで条件に一致する複数行を抽出するコード
次のコードを標準モジュールへ記述します。
Option Explicit
Sub ExtractRows()
Dim wsData As Worksheet
Dim wsSearch As Worksheet
Dim lastRow As Long
Dim lastResultRow As Long
Dim target As String
Dim source As Variant
Dim result() As Variant
Dim i As Long
Dim hitCount As Long
Set wsData = ThisWorkbook.Worksheets("データ")
Set wsSearch = ThisWorkbook.Worksheets("検索条件")
target = CStr(wsSearch.Range("B4").Value)
' 前回の抽出結果を消去
lastResultRow = wsSearch.Cells(wsSearch.Rows.Count, "B").End(xlUp).Row
If lastResultRow >= 8 Then
wsSearch.Range("B8:F" & lastResultRow).ClearContents
End If
If Len(target) = 0 Then Exit Sub
' 品名が入るE列を基準に最終行を取得
lastRow = wsData.Cells(wsData.Rows.Count, "E").End(xlUp).Row
If lastRow < 4 Then Exit Sub
' B列～F列を配列へ読み込む
source = wsData.Range("B4:F" & lastRow).Value
' 条件に一致する件数を数える
For i = 1 To UBound(source, 1)
If CStr(source(i, 4)) = target Then
hitCount = hitCount + 1
End If
Next i
If hitCount = 0 Then Exit Sub
' 一致件数に合わせて結果配列を確保
ReDim result(1 To hitCount, 1 To 5)
hitCount = 0
' 条件に一致する行を結果配列へ格納
For i = 1 To UBound(source, 1)
If CStr(source(i, 4)) = target Then
hitCount = hitCount + 1
result(hitCount, 1) = source(i, 1)
result(hitCount, 2) = source(i, 2)
result(hitCount, 3) = source(i, 3)
result(hitCount, 4) = source(i, 4)
result(hitCount, 5) = source(i, 5)
End If
Next i
' B8セルから一致件数分だけ一括出力
wsSearch.Range("B8").Resize(hitCount, 5).Value = result
End Subコードの流れ
元データと検索条件を取得する
targetには「検索条件」シートのB4セルを入れます。元データの最終行は、今回の検索対象である品名列Eを基準に取得します。
その後、B4:F最終行の範囲をsourceへまとめて読み込みます。セルを1つずつ読み続けるのではなく、いったん配列へ入れてから判定する形です。
一致件数を数えて配列サイズを決める
最初のループでは、品名にあたるsource(i, 4)と検索条件を比較し、一致した件数をhitCountへ数えます。
件数が分かったら、ReDim result(1 To hitCount, 1 To 5)で必要な行数だけ結果用配列を確保します。固定で100行などと決めないため、結果が3件でも30件でも同じコードで処理できます。
結果を別シートへ一括出力する
2回目のループでは、一致した行のB列からF列に相当する5項目をresultへ格納します。
最後にResize(hitCount, 5)で出力範囲を一致件数×5列へ広げ、B8セルから一括で書き込みます。Resizeには行数と列数を指定するため、結果件数に合わせた範囲だけを更新できます。
実行手順
- 「検索条件」シートのB4セルへ抽出したい品名を入力します。
- VBAエディターで
ExtractRowsを実行します。 - 条件に一致した行がB8:F以降へ一覧で出力されます。
このコードでは実行前に前回の結果を消去しています。そのため、今回の検索結果が0件だった場合に、前回の結果だけが残って「抽出できたように見える」状態を避けられます。
複数条件に広げるときの考え方
この記事の中心は1条件での複数行抽出です。条件を増やしたい場合は、抽出処理そのものを変えるのではなく、Ifの判定条件を追加します。
たとえば「品名が一致し、価格が1,000円以上」の両方を満たす行だけを対象にするなら、件数を数えるループと結果を格納するループの2か所にある判定条件を、どちらも同じ条件へ変更します。F列の価格が数値で入力されている前提なら、判定は次のように書けます。
If CStr(source(i, 4)) = target And source(i, 5) >= 1000 Then条件が増えるほど、どの列を何と比較しているかが分かりにくくなります。まず1条件の抽出を動かし、その後で必要な条件だけを追加する方が確認しやすくなります。
よくある失敗
Dim Search_Y, R_Y As Longでは両方がLongにならない
VBAでは、同じDim文へ複数の変数を書いても、型指定はそれぞれの変数に必要です。たとえばDim Search_Y, R_Y As Longと書くと、R_YはLongですがSearch_YはVariantになります。
型をそろえる場合は、次のように個別に指定します。
Dim Search_Y As Long
Dim R_Y As Longこの記事のコードではOption Explicitを入れ、使用する変数をすべて明示的に宣言しています。
固定長配列にすると結果件数と出力範囲がずれやすい
Dim Result(100, 5)のように固定件数で用意すると、実際の一致件数が少ない場合でも余分な領域を持ちます。また、出力時に固定の上限を使うと、空白行まで書き込む原因になります。
一致件数を先に数え、ReDimで必要な大きさだけ確保すると、抽出件数と出力範囲をそろえやすくなります。
列番号が変わると判定位置も変わる
今回のsourceはB列からF列を読み込んでいるため、配列内ではB列が1列目、E列の品名が4列目です。元データの列構成を変更した場合は、source(i, 4)などの位置も見直す必要があります。
まとめ
Excel VBAで条件に一致する複数行を抽出する場合は、元データを配列へ読み込み、条件に一致する件数を数えてから結果用配列を確保すると、固定件数に依存せず処理できます。
今回のポイントは、検索条件を明確にすること、前回結果を先に消すこと、一致件数に合わせてReDimすること、最後にResizeで必要な範囲だけ一括出力することです。まず1条件で正しく抽出できる形を作り、必要になったときだけ判定条件を追加すると保守しやすくなります。
関連記事
- 【Excel】ＶＢＡで特定項目の抽出方法をコードで解説
- Excel VBAとは？マクロとの関係とできることをわかりやすく解説
- Excel・業務自動化とは？関数・Power Query・VBAを体系的に解説
