hiko-blog

VBA業務改善

MENU

列に各行の最後の非空セルの値を転記

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