日本語名

部品_行抽出_条件一致

英語名

FilterRows

URL

https://feelcodelab.com/vba_parts/filterrows/

用途

・元の範囲（データの行）から、条件の列の値が、条件値と一致する行だけを抽出し、
  抽出先の左上セルから、上詰めで書き込む（全列・値のみ）
・条件に一致する行が 1 行も無い場合も、成功（True）として扱い、何も書き込まない
※ この部品は Sub（プロシージャ）ではなく「Function（関数）」で、成功／失敗を Boolean で返す

基礎区分

土台

用途区分

処理

操作対象区分

範囲

前提条件

・【最重要】この部品は Function（関数）であり、戻り値（Boolean）を返す
  → 処理できた場合は True、実行時にできなかった場合は False（この場合は、エラーでは止まらない）
  → 呼び出し側は、必ず戻り値を確認してから後続処理を行い、メッセージも呼び出し側で表示する
    （False のときは、MsgBox のあとに Exit Sub まで書く）
・【最重要】元の範囲（vSrcRng）は、見出し行を含めない、データの行だけの範囲を、呼び出し側が、
  範囲設定の部品で作って、変数に入れて渡す（最終行が可変の場合は、範囲設定_行可変）
  → 抽出するのは、元の範囲の「全列」。抽出した行は、元の範囲と同じ列の並びで書き込まれる
・【最重要】抽出先（vDstTopLeft）は、書き込みを始める「左上のセル」を、範囲設定_固定などで作って渡す
  → 抽出先の見出し行・初期化（範囲消去）・書き込み位置（最終行の次など）は、呼び出し側で決める。
    この部品は、渡されたセルから、上書きで書き込む（既存のデータを、消さず、追記もしない）
・条件の列（vCondCol）は、元の範囲の「左端の列」を 1 とした番号（シート上の列番号ではない）
  → 例：範囲が B 列から始まる場合、B 列は 1、C 列は 2
・条件の判定は「完全一致」で、英字の大文字・小文字は区別する（MATCH検索位置取得と同じ）
  文字列の「1」と数値の 1 は、一致しない。数値と日付は、値が同じなら一致する。
  条件の列の、セルのエラー値（#N/A など）・空白のセルは、一致しない
・条件値が空（Empty・空文字・Null・エラー値）の場合は、呼び出し側の誤りとして、エラーで止まる
・書き込むのは「値のみ」（書式・数式は書かない。数式は、結果の値になる）
・抽出する行を、先にすべて配列に取り込んでから書き込むため、元の範囲と抽出先が、重なっていても、
  元の値が、書き込みで壊れることはない（ただし、重ねて使うことは、おすすめしない）
・設定の誤りは、False ではなく、原因を示すエラーで止まる（Err.Raise）
    - 元の範囲・抽出先が Nothing（vbObjectError + 1014）
    - 条件の列の位置が、元の範囲の列数の外（vbObjectError + 1015）
    - 条件値が空（vbObjectError + 1016）
    - 書き込み先が、シートの上限を超える（vbObjectError + 1009）
・Offset / Find / Resize / With は禁止（抽出は、配列に取り込んで比較する）

依存関係（部品）

・他の部品を参照しない（土台）
・組み合わせ：範囲設定_行可変（元の範囲）＋ 範囲設定_固定（抽出先）→ 行抽出_条件一致
  （呼び出し側が、範囲を作って変数に入れ、その変数を渡す）
・組み合わせ：範囲消去_値のみ → 行抽出_条件一致
  （抽出先を毎回作り直す場合は、先に、抽出先の範囲を消去しておく）

依存関係（シート）

・特定のシートや表の名前には、依存しない（呼び出し側が渡した範囲だけを使う）
・元の範囲（vSrcRng）は、見出し行を含めない、データの行だけの範囲にする
・抽出先（vDstTopLeft）は、書き込みを始める左上のセル。抽出先の見出し行・初期化・書き込み位置は、呼び出し側が決める
・条件の列（vCondCol）は、元の範囲の左端の列を 1 とした番号（シート上の列番号ではない）

引数

vSrcRng     : 元の範囲（Range）。見出し行を含まない、データの行だけ。範囲設定の部品で作る
vCondCol    : 条件の列の位置（Long）。元の範囲の左端を 1 とした番号
vCondValue  : 条件値（Variant）。文字列・数値・日付
vDstTopLeft : 抽出先の、書き込みを始める左上のセル（Range）。範囲設定_固定などで作る

戻り値

Boolean : 処理できた場合（0 件も含む）は True、実行時にできなかった場合は False

戻り値の型

Boolean

コード全文

Function 部品_行抽出_条件一致( _
        ByVal vSrcRng As Range, _
        ByVal vCondCol As Long, _
        ByVal vCondValue As Variant, _
        ByVal vDstTopLeft As Range) As Boolean

    部品_行抽出_条件一致 = f_FilterRows(vSrcRng, vCondCol, vCondValue, vDstTopLeft)

End Function

Function f_FilterRows( _
        ByVal vSrcRng As Range, _
        ByVal vCondCol As Long, _
        ByVal vCondValue As Variant, _
        ByVal vDstTopLeft As Range) As Boolean

    Dim arr As Variant
    Dim outArr As Variant
    Dim matchRows() As Long
    Dim cellValue As Variant
    Dim rowCount As Long
    Dim colCount As Long
    Dim matchCount As Long
    Dim dstLastRow As Long
    Dim dstLastCol As Long
    Dim wsDst As Worksheet
    Dim isCondText As Boolean
    Dim isMatch As Boolean
    Dim i As Long
    Dim j As Long

    f_FilterRows = False

    If vSrcRng Is Nothing Then
        Err.Raise vbObjectError + 1014, "f_FilterRows", _
                  "元の範囲（vSrcRng）が設定されていません（Nothing）。"
    End If

    If vDstTopLeft Is Nothing Then
        Err.Raise vbObjectError + 1014, "f_FilterRows", _
                  "抽出先（vDstTopLeft）が設定されていません（Nothing）。"
    End If

    rowCount = vSrcRng.Rows.Count
    colCount = vSrcRng.Columns.Count

    If vCondCol < 1 Or vCondCol > colCount Then
        Err.Raise vbObjectError + 1015, "f_FilterRows", _
                  "条件の列の位置は、元の範囲の列数（" & colCount & "列）の中で、" & _
                  "左端を 1 として指定してください（条件の列の位置=" & vCondCol & "）。"
    End If

    If IsError(vCondValue) Then
        Err.Raise vbObjectError + 1016, "f_FilterRows", _
                  "条件値（vCondValue）が、エラー値です。"
    End If

    If IsNull(vCondValue) Or IsEmpty(vCondValue) Then
        Err.Raise vbObjectError + 1016, "f_FilterRows", _
                  "条件値（vCondValue）が空です（Empty または Null）。"
    End If

    If VarType(vCondValue) = vbString Then
        If Len(vCondValue) = 0 Then
            Err.Raise vbObjectError + 1016, "f_FilterRows", _
                      "条件値（vCondValue）が空です（空文字）。"
        End If
    End If

    If rowCount = 1 And colCount = 1 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = vSrcRng.Value
    Else
        arr = vSrcRng.Value
    End If

    isCondText = (VarType(vCondValue) = vbString)

    ReDim matchRows(1 To rowCount)
    matchCount = 0

    For i = 1 To rowCount

        cellValue = arr(i, vCondCol)
        isMatch = False

        If IsError(cellValue) = False Then

            If VarType(cellValue) = vbString Then

                If isCondText Then
                    If StrComp(cellValue, vCondValue, vbBinaryCompare) = 0 Then isMatch = True
                End If

            ElseIf IsEmpty(cellValue) = False Then

                If isCondText = False Then
                    If cellValue = vCondValue Then isMatch = True
                End If

            End If

        End If

        If isMatch Then
            matchCount = matchCount + 1
            matchRows(matchCount) = i
        End If

    Next i

    If matchCount = 0 Then
        f_FilterRows = True
        Exit Function
    End If

    dstLastRow = vDstTopLeft.Row + matchCount - 1
    dstLastCol = vDstTopLeft.Column + colCount - 1

    If dstLastRow > vDstTopLeft.Worksheet.Rows.Count Or dstLastCol > vDstTopLeft.Worksheet.Columns.Count Then
        Err.Raise vbObjectError + 1009, "f_FilterRows", _
                  "抽出した行（" & matchCount & "行）が、シートの上限（" & vDstTopLeft.Worksheet.Rows.Count & "行・" & _
                  vDstTopLeft.Worksheet.Columns.Count & "列）を超えます" & _
                  "（書き込みの終了行=" & dstLastRow & "、終了列=" & dstLastCol & "）。"
    End If

    ReDim outArr(1 To matchCount, 1 To colCount)

    For i = 1 To matchCount
        For j = 1 To colCount
            outArr(i, j) = arr(matchRows(i), j)
        Next j
    Next i

    On Error GoTo ErrHandler

    Set wsDst = vDstTopLeft.Worksheet
    wsDst.Range(wsDst.Cells(vDstTopLeft.Row, vDstTopLeft.Column), _
                wsDst.Cells(dstLastRow, dstLastCol)).Value = outArr

    f_FilterRows = True
    Exit Function

ErrHandler:
    Debug.Print "f_FilterRows: " & Err.Number & " " & Err.Description
    f_FilterRows = False

End Function

呼び出し・活用事例

◆例：元データの 3 列目が「東京」の行を、抽出結果シートへ書き出す◆
Dim src As Range
Dim dst As Range

Set src = 部品_範囲設定_行可変(ThisWorkbook, "元データ", 2, 1, 5, 3)      '2行目から、1～5列目。最終行は3列目で判定
If src Is Nothing Then MsgBox "元データがありません": Exit Sub

Set dst = 部品_範囲設定_固定(ThisWorkbook, "抽出結果", 2, 1, 2, 1)        '2行目・1列目から書き込む
If 部品_行抽出_条件一致(src, 3, "東京", dst) = False Then
    MsgBox "行の抽出に失敗しました"
    Exit Sub
End If
'→ 元データの3列目（範囲の3列目）が「東京」の行が、抽出結果シートの2行目から、上詰めで書き込まれる
'→ Rows whose 3rd column is "東京" are written from row 2 of the destination, packed upward

※ 設定の誤り（Nothing、条件の列の位置の誤り、条件値が空）の場合は、False ではなく、
   原因を示すエラーで止まる（起点で On Error で受けて、Err.Description を表示する）

BASファイル（ダウンロード）

FilterRows.bas

バージョン

1.0

更新日

2026-10-30