色のついたセルをカウントしたい

セルの色をカウントしたい

Sub 色をカウント()
 
    Dim Rng As Range
    Dim Red_cnt As Long
    Dim yellow_cnt As Long
    Dim Black_cnt As Long
    Dim i As Long
    Dim j As Long
    
    For i = 2 To 6
     For j = 2 To 9
          i = i + 1

    For Each Rng In Cells(i, j)
  
     
        Select Case Rng.Interior.ColorIndex
          
            '赤
            Case 3
                Red_cnt = Red_cnt + 1
                 
            '黄色
            Case 6
                yellow_cnt = yellow_cnt + 1
    　　　　　’黒
            Case 2
                Black_cnt = Blackw_cnt + 1
          
        End Select
    Next Rng
    Next j
    Next i
    
     
    Cells(2, j) = Red_cnt
    Cells(2, j + 1) = yellow_cnt
    Cells(2, j + 2) = Black_cnt
End Sub

セルB2～セルI6までセルに色がついています。
色は、赤、黄色、黒です。
この色のついたセルをカウントしたいと思っています。

例セルB2～セルI2まで色をカウントした結果を,
セルJ2へ赤いセルの個数
セルK2へ黄色いセルの個数
セルL2へ黒いセルの個数

例セルB3～セルI3まで色をカウントした結果を,
セルJ3へ赤いセルの個数
セルK3へ黄色いセルの個数
セルL3へ黒いセルの個数
・
・
・
・
・

例セルB6～セルI6まで色をカウントした結果を,
セルJ6へ赤いセルの個数
セルK6へ黄色いセルの個数
セルL6へ黒いセルの個数

二重ループの問題だとおもうのですが、うまく作動しません。

お手数ですが、ご教示をお願いしまます。

行動規範の内容に同意します

回答1件

ベストアンサー

行ごとの集計ということで、何度も修正して申し訳ありません。

VBA
1
2Sub 色をカウント()
3
4    Dim Red_cnt As Long
5    Dim yellow_cnt As Long
6    Dim Black_cnt As Long
7    Dim i As Long
8    Dim j As Long
9    Dim mycolor As Integer
10
11    '合計用に文字を追記する
12
13    Cells(1, 10).Value = "赤"
14    Cells(1, 11).Value = "黄色"
15    Cells(1, 12).Value = "黒"
16    
17    
18    For i = 2 To 6
19     For j = 2 To 9
20     
21       mycolor = Cells(i, j).Interior.ColorIndex
22
23        Cells(i, j).Value = mycolor
24
25        Select Case mycolor
26
27            '赤
28            Case 3
29                Red_cnt = Red_cnt + 1
30
31            '黄色
32            Case 6
33                yellow_cnt = yellow_cnt + 1
34              '黒
35            Case 1
36                Black_cnt = Black_cnt + 1
37
38        End Select
39        
40
41    Next j
42            '合計値+初期化
43         
44            Cells(i, j).Value = Red_cnt
45            Cells(i, j + 1).Value = yellow_cnt
46            Cells(i, j + 2).Value = Black_cnt
47            
48            Red_cnt = 0
49            yellow_cnt = 0
50            Black_cnt = 0
51        
52            
53    Next i
54
55End Sub