| 
    
     |  | SS さん、かみちゃんさん おはようございます。 面白そうなので考えてみました。
 色つきせるのカウントはCsum関数のなかで処理しています。
 
 
 Sub test()
 
 Dim rngA As Range
 Dim rowA As Long
 Dim colA As Long
 Dim i As Long
 
 rowA = Range("A65536").End(xlUp).Row
 colA = Range("IV2").End(xlToLeft).Column
 
 For i = 4 To colA
 Set rngA = Cells(3, i).Resize(rowA - 2)
 Cells(rowA + 1, i).Value = Application.Count(rngA)
 Cells(rowA + 2, i).Value = cSum(rngA, 6) '黄
 Cells(rowA + 3, i).Value = cSum(rngA, 3) '赤
 Next i
 
 End Sub
 
 
 Function cSum(rngA As Range, c As Long) As Long
 Dim R As Range
 For Each R In rngA
 If R.Interior.ColorIndex = c Then
 cSum = cSum + 1
 End If
 Next
 End Function
 
 |  |