Option Explicit

'===========================================================
' 部品_行抽出_条件一致 / FilterRows
'   ・元の範囲（データの行）から、条件の列の値が、条件値と一致する行だけを抽出し、
'     抽出先の左上セルから、上詰めで書き込む（全列・値のみ）
'     → Extracts only the rows whose condition-column value equals the condition value from the source
'        range and writes them, packed upward, from the destination top-left cell (all columns, values only).
'
'   ・条件に一致する行が 1 行も無い場合も、成功（True）として扱い、何も書き込まない
'     → If no row matches, it is still a success (True) and nothing is written.
'
'   ※ この部品は Sub（プロシージャ）ではなく「Function（関数）」で、成功／失敗を Boolean で返す
'     → ※ This component is a Function (not a Sub) that returns success/failure as a Boolean.
'===========================================================

'===========================================================
' ■区分 / Classification
'   ・基礎区分：土台 ／ 用途区分：処理 ／ 操作対象区分：範囲
'     → Base: foundation / Purpose: process / Target: range
'
' ■バージョン / Version
'   ・Version 1.0（2026-10-30）
'===========================================================

'===========================================================
' ■URL（WordPress部品ページ）
'   https://feelcodelab.com/vba_parts/filterrows/
'===========================================================

'===========================================================
' ■前提条件（AI誤動作防止の最重要項目） / Preconditions
'   ・【最重要】この部品は Function（関数）であり、戻り値（Boolean）を返す
'     → 処理できた場合は True、実行時にできなかった場合は False（この場合は、エラーでは止まらない）
'     → 呼び出し側は、必ず戻り値を確認してから後続処理を行い、メッセージも呼び出し側で表示する
'       （False のときは、MsgBox のあとに Exit Sub まで書く）
'     → [MOST IMPORTANT] This component is a Function that returns a Boolean: True if it worked, False if it
'        failed at run time (no error is raised then). The caller must check the return value before the
'        following processing and show any message itself (write Exit Sub after the MsgBox).
'
'   ・【最重要】元の範囲（vSrcRng）は、見出し行を含めない、データの行だけの範囲を、呼び出し側が、
'     範囲設定の部品で作って、変数に入れて渡す（最終行が可変の場合は、範囲設定_行可変）
'     → 抽出するのは、元の範囲の「全列」。抽出した行は、元の範囲と同じ列の並びで書き込まれる
'     → [MOST IMPORTANT] Pass the data rows only (no header row), made by a range-setting component.
'        All columns of the range are extracted, in the same column order.
'
'   ・【最重要】抽出先（vDstTopLeft）は、書き込みを始める「左上のセル」を、範囲設定_固定などで作って渡す
'     → 抽出先の見出し行・初期化（範囲消去）・書き込み位置（最終行の次など）は、呼び出し側で決める。
'       この部品は、渡されたセルから、上書きで書き込む（既存のデータを、消さず、追記もしない）
'     → [MOST IMPORTANT] Pass the top-left cell where writing starts. Clearing the destination and choosing
'        the position (e.g., the row after the last row) are the caller's job; existing values are overwritten.
'
'   ・条件の列（vCondCol）は、元の範囲の「左端の列」を 1 とした番号（シート上の列番号ではない）
'     → 例：範囲が B 列から始まる場合、B 列は 1、C 列は 2
'     → The condition column is a number counted with the left-most column of the source range as 1.
'
'   ・条件の判定は「完全一致」で、英字の大文字・小文字は区別する（MATCH検索位置取得と同じ）
'     文字列の「1」と数値の 1 は、一致しない。数値と日付は、値が同じなら一致する。
'     条件の列の、セルのエラー値（#N/A など）・空白のセルは、一致しない
'     → Exact match, case-sensitive (same as GetMatchPosition); text "1" and number 1 do not match.
'
'   ・条件値が空（Empty・空文字・Null・エラー値）の場合は、呼び出し側の誤りとして、エラーで止まる
'     → An empty condition value stops with an error as a caller mistake.
'
'   ・書き込むのは「値のみ」（書式・数式は書かない。数式は、結果の値になる）
'     → Only values are written (formatting and formulas are not).
'
'   ・抽出する行を、先にすべて配列に取り込んでから書き込むため、元の範囲と抽出先が、重なっていても、
'     元の値が、書き込みで壊れることはない（ただし、重ねて使うことは、おすすめしない）
'     → Rows are loaded into an array first, so overlapping source and destination do not corrupt the values.
'
'   ・設定の誤りは、False ではなく、原因を示すエラーで止まる（Err.Raise）
'       - 元の範囲・抽出先が Nothing（vbObjectError + 1014）
'       - 条件の列の位置が、元の範囲の列数の外（vbObjectError + 1015）
'       - 条件値が空（vbObjectError + 1016）
'       - 書き込み先が、シートの上限を超える（vbObjectError + 1009）
'     → Setting mistakes stop with an error naming the cause instead of returning False.
'
'   ・Offset / Find / Resize / With は禁止（抽出は、配列に取り込んで比較する）
'     → Offset, Find, Resize, and With statements are prohibited.
'===========================================================

'===========================================================
' ■依存関係（部品名明記） / Component Dependencies
'   ・他の部品を参照しない（土台）
'     → References no other component (foundation).
'
'   ・組み合わせ：範囲設定_行可変（元の範囲）＋ 範囲設定_固定（抽出先）→ 行抽出_条件一致
'     （呼び出し側が、範囲を作って変数に入れ、その変数を渡す）
'     → Typical combination: [SetRange_VariableRows] + [SetRange_Fixed] -> [FilterRows]
'
'   ・組み合わせ：範囲消去_値のみ → 行抽出_条件一致
'     （抽出先を毎回作り直す場合は、先に、抽出先の範囲を消去しておく）
'     → Typical combination: [ClearRange_ValuesOnly] -> [FilterRows] (to rebuild the destination each time).
'===========================================================

'===========================================================
' ■依存関係（シート・表） / Sheet Dependencies
'   ・特定のシートや表の名前には、依存しない（呼び出し側が渡した範囲だけを使う）
'     → Does not depend on any specific sheet or table name; it uses only the range passed by the caller.
'
'   ・元の範囲（vSrcRng）は、見出し行を含めない、データの行だけの範囲にする
'     → The source range (vSrcRng) holds only the data rows, without the header row.
'
'   ・抽出先（vDstTopLeft）は、書き込みを始める左上のセル。抽出先の見出し行・初期化・書き込み位置は、呼び出し側が決める
'     → The destination (vDstTopLeft) is the top-left cell to start writing; the caller decides the header, the clearing and the write position.
'
'   ・条件の列（vCondCol）は、元の範囲の左端の列を 1 とした番号（シート上の列番号ではない）
'     → The condition column (vCondCol) counts from the left-most column of the source range as 1 (not the sheet column number).
'===========================================================

'===========================================================
' ■技術解説 / Technical Notes
'
'   ・範囲（Range）で受け取る理由
'       → 範囲消去・範囲コピーと同じく、範囲は、自分のブック・シートを持っているため、ブックやシート名の
'          引数が不要で、部品が他の部品（範囲設定・最終行取得）を参照しなくて済む。
'       → A Range carries its own workbook and sheet, so no other component needs to be referenced.
'
'   ・抽出先の初期化・追記位置を、部品の中に入れない理由
'       → 呼び出し側が、どんなコードを書くかによる（毎回作り直す・末尾に追記する、など）。迷ったら分ける。
'          旧版は、抽出先の最終行の次へ、追記する作りだったが、部品を使う側が選べるように、位置を引数で受け取る。
'       → The caller decides (rebuild each time, append, etc.); when in doubt, split.
'
'   ・条件に一致する行が無い場合も、True にする理由
'       → 一致する行が無いことは、失敗ではなく、結果のひとつ。複数の処理の一部として使うときは、
'          「該当なしでも、次の処理へ進む」ことが多い。件数が必要な場合は、別の部品にする（迷ったら分ける）。
'       → No match is a result, not a failure; the count is not returned (use a separate component if needed).
'
'   ・行を配列に取り込んで、まとめて書き込む理由
'       → セルごとの書き込みより高速で、1 回の代入で書き込めるため、途中で失敗して、中途半端に書き込まれた
'          状態になりにくい。
'       → Faster than cell-by-cell writing, and a single assignment avoids half-written results.
'
'   ・Offset / Find / Resize / With を禁止する理由
'       → 生成AIが誤って不正な範囲操作を行う可能性が高く、行数可変の処理で誤動作を引き起こしやすいため。
'       → These statements often cause misaligned or ambiguous range operations when generated by AI.
'===========================================================

'---------------------------------------------
' ■引数（型＋意味） / Arguments
'   vSrcRng     : 元の範囲（Range）。見出し行を含まない、データの行だけ。範囲設定の部品で作る
'                 → Source range (Range); data rows only, without the header row.
'
'   vCondCol    : 条件の列の位置（Long）。元の範囲の左端を 1 とした番号
'                 → Position of the condition column (Long); left-most column of the source range = 1.
'
'   vCondValue  : 条件値（Variant）。文字列・数値・日付
'                 → Condition value (Variant): text, number, or date.
'
'   vDstTopLeft : 抽出先の、書き込みを始める左上のセル（Range）。範囲設定_固定などで作る
'                 → Top-left cell of the destination where writing starts (Range).
'---------------------------------------------

'---------------------------------------------
' ■戻り値（型＋意味） / Return Value
'   Boolean : 処理できた場合（0 件も含む）は True、実行時にできなかった場合は False
'             → True if it worked (including zero matches), False if it failed at run time.
'---------------------------------------------

'---------------------------------------------
' ■エラー / Errors (Err.Raise)
'   ・vbObjectError + 1009：書き込み先が、シートの上限を超える
'   ・vbObjectError + 1014：元の範囲・抽出先が Nothing
'   ・vbObjectError + 1015：条件の列の位置が、元の範囲の列数の外（1 未満、または列数より大きい）
'   ・vbObjectError + 1016：条件値が空（Empty・空文字・Null・エラー値）
'---------------------------------------------

'===========================================================
' ■禁止事項（AI向け） / Prohibitions
'   ・Function を Sub（プロシージャ）に変更することの禁止
'     → Do not convert this Function into a Sub; the Boolean return value is essential.
'
'   ・戻り値（Boolean）を確認せずに後続処理を行うことの禁止
'     → Do not proceed to the following processing without checking the Boolean return value.
'
'   ・元の範囲に、見出し行を含めることの禁止
'     → Do not include the header row in the source range.
'
'   ・条件の列の位置を、シート上の列番号（A 列＝1 など）と取り違えることの禁止
'     （元の範囲の左端の列を 1 とした番号で指定する）
'     → Do not confuse the condition column with a sheet column number.
'
'   ・抽出先の見出し行・初期化・追記位置を、この部品が行うと思い込むことの禁止
'     （呼び出し側が、別の部品で行う）
'     → Do not assume this component writes headers, clears, or appends; the caller does that.
'
'   ・セル参照の直書き禁止（Range("A1") など）
'     → Hard-coded cell references are prohibited.
'
'   ・Offset禁止 / Find禁止 / Resize禁止 / With禁止
'     → Offset, Find, Resize, and With blocks are prohibited.
'===========================================================

'===========================================================
' ■使用例（サンプルコード） / Example
'   ◆例：元データの 3 列目が「東京」の行を、抽出結果シートへ書き出す / Example◆
'   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 を表示する）
'===========================================================

'===========================================================
' ■ラッパー関数（日本語名） / Wrapper Function
'   ・辞書の日本語名で呼び出すための窓口
'     → Entry point callable by the Japanese dictionary name.
'
'   ・内部では英語名の本体処理を呼び出し、結果（Boolean）をそのまま返す
'     → Internally calls the English-named core function and returns its result (Boolean) as it is.
'===========================================================
Function 部品_行抽出_条件一致( _
        ByVal vSrcRng As Range, _
        ByVal vCondCol As Long, _
        ByVal vCondValue As Variant, _
        ByVal vDstTopLeft As Range) As Boolean

    '本体処理（英語名）を呼び出し、結果をそのまま返す / Call core function and return its result
    部品_行抽出_条件一致 = f_FilterRows(vSrcRng, vCondCol, vCondValue, vDstTopLeft)

End Function

'===========================================================
' ■本体処理（英語名） / Core Function
'   ・条件の列の値が一致する行だけを、抽出先の左上セルから、上詰めで書き込む（値のみ）
'     → Writes only the rows whose condition-column value matches, packed upward from the destination top-left.
'
'   ・処理できた場合：True、実行時にできなかった場合：False を返す
'     → Returns True if it worked and False if it failed at run time.
'===========================================================
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

    '---------------------------------------------
    ' ■範囲・条件の列の位置・条件値を確認（誤りの場合はエラーで止める）
    '   ※ On Error GoTo より前に置く（Err.Raise を False に変えず、呼び出し側へ届けるため）
    '   / Check the ranges, the condition column and the condition value (stop with an error if wrong);
    '     placed before On Error GoTo so that Err.Raise reaches the caller
    '---------------------------------------------
    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

    '---------------------------------------------
    ' ■値を配列に取り込む（1 セルだけの場合は、配列にならないため、配列を作って入れる）
    '   / Load values into an array (a single cell returns a scalar, so build a 1x1 array)
    '---------------------------------------------
    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)

    '---------------------------------------------
    ' ■条件に一致する行を探す（上から順に。一致した行の番号を控える）
    '   / Find the matching rows from the top (keep their row numbers)
    '---------------------------------------------
    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

                '文字列同士：大文字・小文字を区別して比較 / text vs text: case-sensitive
                If isCondText Then
                    If StrComp(cellValue, vCondValue, vbBinaryCompare) = 0 Then isMatch = True
                End If

            ElseIf IsEmpty(cellValue) = False Then

                '数値・日付同士：値が同じなら一致 / number/date: equal if the values are the same
                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

    '一致する行が無い場合は、何も書き込まず、成功として終わる / No match: write nothing, success
    If matchCount = 0 Then
        f_FilterRows = True
        Exit Function
    End If

    '---------------------------------------------
    ' ■書き込み先が、シートの上限を超えないかを確認（超える場合はエラーで止める）
    '   / Check that the destination does not exceed the sheet limit (stop with an error if it does)
    '---------------------------------------------
    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

    '---------------------------------------------
    ' ■抽出した行を、配列にまとめる / Gather the matched rows into an array
    '---------------------------------------------
    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

    '---------------------------------------------
    ' ■エラー時は ErrHandler へ（False を返す） / On error, jump to ErrHandler (returns False)
    '---------------------------------------------
    On Error GoTo ErrHandler

    '---------------------------------------------
    ' ■書き込み（1 回の代入） / Write (a single assignment)
    '---------------------------------------------
    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