[ChatGPT To VBA] シート名と開始ヘッダー名と終了ヘッダー名を引数に指定してその範囲の二行目から最終行までを二次元配列に代入して返す。

'シート名と開始ヘッダー名と終了ヘッダー名を引数に指定してその範囲の二行目から最終行までを二次元配列に代入して返す。
'※開始と終了を同じにして一列でも取得可能
Function GetRangeValues(sheetName As String, startHeaderName As String, endHeaderName As String) As Variant
    Dim lastRow As Long
    Dim headerStart As Range
    Dim headerEnd As Range
    Dim columnData As Variant
    
    'シート名を指定してシートオブジェクトを取得する
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(sheetName)
    
    '開始するヘッダー名が格納されている列を取得する
    Set headerStart = ws.Rows(1).Find(startHeaderName, LookIn:=xlValues, LookAt:=xlWhole)
    
    '開始するヘッダーが見つからなかった場合はエラーを返す
    If headerStart Is Nothing Then
        Err.Raise 1001, , "開始するヘッダー名が見つかりませんでした。"
    End If
    
    '終了するヘッダー名が格納されている列を取得する
    Set headerEnd = ws.Rows(1).Find(endHeaderName, LookIn:=xlValues, LookAt:=xlWhole)
    
    '終了するヘッダーが見つからなかった場合はエラーを返す
    If headerEnd Is Nothing Then
        Err.Raise 1002, , "終了するヘッダー名が見つかりませんでした。"
    End If
    
    '開始するヘッダー名と終了するヘッダー名の範囲に含まれる列の値を配列に代入する
    columnData = ws.Range(headerStart.Offset(1), headerEnd.Offset(ws.Cells(ws.Rows.Count, headerEnd.Column).End(xlUp).row - headerEnd.row + headerStart.row -1, 0)).Value
    
    '配列を返す
    GetRangeValues = columnData
End Function

Related Posts