セルを間引いて色を塗る
コピペでもいけます。
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