Seasons.NET

ちょっとした技術ブログです

セルを間引いて色を塗る

コピペでもいけます。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim wSheet As Worksheet
    Dim StartCellRow As Integer
    Dim EndCellRow As Integer
    Dim CheckCell As String
    Dim CellRange As String
    Dim ModVal As Integer

    '======================================================
    'ユーザー変更エリア
    '======================================================
    '------------------------------------------------------
    'ターゲットセル
    Const TargetCellValue As String = "枚数"
    '------------------------------------------------------
    'セルの範囲
    Const StartCellIndex As Integer = 9 '開始セルインデックス
    Const StartCellColumnStr As String = "B" '開始カラム
    Const EndCellColumnStr As String = "Q" '終了カラム

    Const Color1 As Integer = 36 'カラー1
    Const Color2 As Integer = 34 'カラー2
    '------------------------------------------------------

    StartCellRow = StartCellIndex
    CheckCell = StartCellColumnStr & StartCellRow

    Do While Range(CheckCell).Value <> TargetCellValue

        CellRange = StartCellColumnStr & StartCellRow & ":" & EndCellColumnStr & StartCellRow

        ModVal = StartCellRow Mod 2
        If ModVal = 1 Then
            CellColorIndex = Color1
        Else
            CellColorIndex = Color2
        End If
        Range(CellRange).Interior.ColorIndex = CellColorIndex
        StartCellRow = StartCellRow + 1
        CheckCell = StartCellColumnStr & StartCellRow

    Loop

End Sub