hiko-blog

VBA業務改善

MENU

HighlightLastNonEmptyCell

Sub HighlightLastNonEmptyCell()
    Dim rng As Range
    Dim 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) ' 黄色
        End If
    Next cell
End Sub