Sub 抽出マッチした値()
Dim lastRowA As Long
Dim lastRowI As Long
Dim i As Long, j As Long
' A列とI列の最終行を取得
lastRowA = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lastRowI = Sheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Row
' B列とC列を初期化
Sheets("Sheet1").Range("B1:C" & lastRowA).ClearContents
' A列の各セルをループ
For i = 1 To lastRowA
' A列の値がI列にマッチした場合
For j = 1 To lastRowI
If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet1").Cells(j, "I").Value Then
' 重複がある場合、C列にJ列の値を書き込む
If i <> j Then
Sheets("Sheet1").Cells(i, "C").Value = Sheets("Sheet1").Cells(j, "J").Value
Exit For
End If
' マッチした場合、B列にJ列の値を書き込む
Sheets("Sheet1").Cells(i, "B").Value = Sheets("Sheet1").Cells(j, "J").Value
End If
Next j
Next i
End Sub