【EXCEL VBA】検索キーを中心に上下左右の値を取得するサンプル

セルの中の項目名を検索キーを中心として、中心から上下左右の値を取得するサンプル

たとえば、こんな感じのセルがあったとき

「項目」をキーにその周囲にある値を取得する。

結合セルのある場合の振る舞いは、エクセルでキー項目を起点に１セルずつ上下から左右に動かした場合を想定した。

Sub test()

    Dim r As Range
    Set r = Range("C2:G6")
   
    ‘ラベル項目と、そのラベル項目からみたオフセット位置を指定する。
    ‘（プラス値：左または下にずらす）
    ‘（マイナス値：右または上にずらす）
    Call GetTargetParameter(r, "項目", 0, -3)
    Call GetTargetParameter(r, "項目", 0, -2)
    Call GetTargetParameter(r, "項目", 0, -1)
    Call GetTargetParameter(r, "項目", 0, 0)
    Call GetTargetParameter(r, "項目", 0, 1)
    Call GetTargetParameter(r, "項目", 0, 2)
    Call GetTargetParameter(r, "項目", 0, 3)
   
    Call GetTargetParameter(r, "項目", 1, -3)
    Call GetTargetParameter(r, "項目", 1, -2)
    Call GetTargetParameter(r, "項目", 1, -1)
    Call GetTargetParameter(r, "項目", 1, 0)
    Call GetTargetParameter(r, "項目", 1, 1)
    Call GetTargetParameter(r, "項目", 1, 2)
    Call GetTargetParameter(r, "項目", 1, 3)

    Call GetTargetParameter(r, "項目", 2, -3)
    Call GetTargetParameter(r, "項目", 2, -2)
    Call GetTargetParameter(r, "項目", 2, -1)
    Call GetTargetParameter(r, "項目", 2, 0)
    Call GetTargetParameter(r, "項目", 2, 1)
    Call GetTargetParameter(r, "項目", 2, 2)
    Call GetTargetParameter(r, "項目", 2, 3)

    Call GetTargetParameter(r, "項目", 3, -3)
    Call GetTargetParameter(r, "項目", 3, -2)
    Call GetTargetParameter(r, "項目", 3, -1)
    Call GetTargetParameter(r, "項目", 3, 0)
    Call GetTargetParameter(r, "項目", 3, 1)
    Call GetTargetParameter(r, "項目", 3, 2)
    Call GetTargetParameter(r, "項目", 3, 3)

End Sub

‘ある指定の範囲からのラベルをキーにデータを取得する。
Function GetTargetParameter(ByRef serchArea As Range, ByVal targetLabel As String, ByVal RowOffset As Integer, ByVal ColumnOffset As Integer) As String
    Dim r As Range
    Dim r2 As Range
   
    GetTargetParameter = 0
    For Each r In serchArea
        If r.Value = targetLabel Then
            ‘オフセット回、セルのアドレスを再設定（起点をずらす）
             Call setOffsetRow(r, RowOffset)
             Call setOffsetColumn(r, ColumnOffset)
             Debug.Print "address=" & r.Address & " value=" & r.Value
             GetTargetParameter = r.Value
            Exit For
        End If
    Next r
   
End Function

Sub setOffsetRow(ByRef r As Range, ByVal RowOffset As Integer)
    Dim i As Integer
    If RowOffset = 0 Then
        Exit Sub
    ElseIf RowOffset < 0 Then
        For i = 1 To Abs(RowOffset)
            Set r = r.Offset(-1, 0)
        Next i
    Else
        For i = 1 To RowOffset
            Set r = r.Offset(1, 0)
        Next i
    End If
End Sub

Sub setOffsetColumn(ByRef r As Range, ByVal ColumnOffset As Integer)
    Dim i As Integer
    If ColumnOffset = 0 Then
        Exit Sub
    ElseIf ColumnOffset < 0 Then
        For i = 1 To Abs(ColumnOffset)
            Set r = r.Offset(0, -1)
        Next i
    Else
        For i = 1 To ColumnOffset
            Set r = r.Offset(0, 1)
        Next i
    End If
End Sub

ためしに流した結果

address=$A$4 value=
address=$B$4 value=
address=$C$4 value=15
address=$D$4 value=項目
address=$G$4 value=16
address=$I$4 value=17
address=$K$4 value=
address=$A$5 value=
address=$B$5 value=
address=$C$5 value=18
address=$D$5 value=19
address=$G$5 value=20
address=$H$5 value=21
address=$I$5 value=22
address=$A$6 value=
address=$B$6 value=
address=$C$6 value=24
address=$D$6 value=25
address=$E$6 value=26
address=$F$6 value=27
address=$G$6 value=28
address=$A$7 value=
address=$B$7 value=
address=$C$7 value=
address=$D$7 value=
address=$E$7 value=
address=$F$7 value=
address=$G$7 value=