Sub Z列に各行の最後の非空セルの値を転記()
Dim rng As Range
Dim C, cell As Range
Dim lastNonEmptyCell As Range
Dim inputRange As Range
' ユーザーにセル範囲を指定させるための InputBox を表示
On Error Resume Next
Set inputRange = Application.InputBox("セル範囲を指定してください。例:A1:E10", "セル範囲選択", Type:=8)
On Error GoTo 0
If inputRange Is Nothing Then Exit Sub ' キャンセルされた場合は処理を終了
' 範囲が有効かどうかチェック
If inputRange.Cells.Count = 1 Then
Set rng = inputRange
ElseIf inputRange.Cells.Count > 1 Then
Set rng = Range(inputRange.Address)
Else
MsgBox "無効なセル範囲が指定されました。", vbExclamation
Exit Sub
End If
' ブロック変数を設定
For Each cell In rng.Rows
Set lastNonEmptyCell = Nothing ' ブロック変数をリセット
' 行内のセルを右から走査
For Each C In cell.Cells
If C.Value <> "" Then
' 空欄でないセルを見つけた場合、最後に見つかった空欄でないセルを保持
If lastNonEmptyCell Is Nothing Then
Set lastNonEmptyCell = C
Else
If C.Column > lastNonEmptyCell.Column Then
Set lastNonEmptyCell = C
End If
End If
End If
Next C
' 最後に見つかった空欄でないセルを黄色に塗りつぶす
If Not lastNonEmptyCell Is Nothing Then
lastNonEmptyCell.Interior.Color = RGB(255, 255, 0) ' 黄色
' Z列(列番号26)に値を転記
cell.Cells(1, 26).Value = lastNonEmptyCell.Value
End If
Next cell
End Sub