シートAのA列に変更があった際に、その値に応じてシートBのA列で一致する値を探し出し、B列の値を取得する

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 変数宣言
    Dim rngTarget As Range  ' 対象セル範囲
    Dim strValue As String  ' 変更された値
    Dim rngFound As Range   ' 一致したセル範囲
    Dim wsSheetB As Worksheet ' シートB
    Dim strFoundValue As String  ' 見つかったB列の値

    ' 変更されたセルがA列にない場合、処理を終了
    If Intersect(Target, Me.Columns("A")) Is Nothing Then Exit Sub

    Set wsSheetB = ThisWorkbook.Sheets("SheetB") ' シートBの設定

    ' 対象範囲内のセルをループ
    For Each rngTarget In Intersect(Target, Me.Columns("A"))
        strValue = rngTarget.Value ' 変更された値を取得

        ' シートBのA列で一致する値を検索
        Set rngFound = wsSheetB.Columns("A").Find(What:=strValue, LookIn:=xlValues, LookAt:=xlWhole)

        ' 一致する値が見つからない場合はスキップ
        If rngFound Is Nothing Then
            MsgBox "一致する値が見つかりませんでした。"
            Exit For
        End If

        ' 一致した値が見つかった場合、B列の値を取得
        strFoundValue = rngFound.Offset(0, 1).Value
        ' 取得した値を任意の処理に使用
        MsgBox "一致する値が見つかりました。B列の値: " & strFoundValue

    Next rngTarget
End Sub

コメント