|
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
|
|