teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問色のついたセルをカウントしたい

編集履歴

回答編集履歴

17

こちらかがいいかも

2020/08/03 10:57

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1 +1,117 @@
1
1
  行ごとの集計ということで、何度も修正して申し訳ありません。
2
+
3
+
4
+
5
+ ```VBA
6
+
7
+
8
+
9
+ Sub 色をカウント()
10
+
11
+
12
+
13
+ Dim Red_cnt As Long
14
+
15
+ Dim yellow_cnt As Long
16
+
17
+ Dim Black_cnt As Long
18
+
19
+ Dim i As Long
20
+
21
+ Dim j As Long
22
+
23
+ Dim mycolor As Integer
24
+
25
+
26
+
27
+ '合計用に文字を追記する
28
+
29
+
30
+
31
+ Cells(1, 10).Value = "赤"
32
+
33
+ Cells(1, 11).Value = "黄色"
34
+
35
+ Cells(1, 12).Value = "黒"
36
+
37
+
38
+
39
+
40
+
41
+ For i = 2 To 6
42
+
43
+ For j = 2 To 9
44
+
45
+
46
+
47
+ mycolor = Cells(i, j).Interior.ColorIndex
48
+
49
+
50
+
51
+ Cells(i, j).Value = mycolor
52
+
53
+
54
+
55
+ Select Case mycolor
56
+
57
+
58
+
59
+ '赤
60
+
61
+ Case 3
62
+
63
+ Red_cnt = Red_cnt + 1
64
+
65
+
66
+
67
+ '黄色
68
+
69
+ Case 6
70
+
71
+ yellow_cnt = yellow_cnt + 1
72
+
73
+ '黒
74
+
75
+ Case 1
76
+
77
+ Black_cnt = Black_cnt + 1
78
+
79
+
80
+
81
+ End Select
82
+
83
+
84
+
85
+
86
+
87
+ Next j
88
+
89
+ '合計値+初期化
90
+
91
+
92
+
93
+ Cells(i, j).Value = Red_cnt
94
+
95
+ Cells(i, j + 1).Value = yellow_cnt
96
+
97
+ Cells(i, j + 2).Value = Black_cnt
98
+
99
+
100
+
101
+ Red_cnt = 0
102
+
103
+ yellow_cnt = 0
104
+
105
+ Black_cnt = 0
106
+
107
+
108
+
109
+
110
+
111
+ Next i
112
+
113
+
114
+
115
+ End Sub
116
+
117
+ ```

16

こちらかがいいかも

2020/08/03 10:57

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,109 +1 @@
1
1
  行ごとの集計ということで、何度も修正して申し訳ありません。
2
-
3
- 何かおかしかったら教えてください。
4
-
5
-
6
-
7
- ```VBA
8
-
9
- Sub 色をカウント()
10
-
11
-
12
-
13
- Dim Red_cnt As Long
14
-
15
- Dim yellow_cnt As Long
16
-
17
- Dim Black_cnt As Long
18
-
19
- Dim i As Long
20
-
21
- Dim j As Long
22
-
23
- Dim mycolor As Integer
24
-
25
-
26
-
27
- '合計用見出し追加
28
-
29
-
30
-
31
- Cells(1, 10).Value = "赤"
32
-
33
- Cells(1, 11).Value = "黄色"
34
-
35
- Cells(1, 12).Value = "黒"
36
-
37
-
38
-
39
-
40
-
41
- For i = 2 To 6
42
-
43
- For j = 2 To 9
44
-
45
-
46
-
47
- mycolor = Cells(i, j).Interior.ColorIndex
48
-
49
-
50
-
51
- Cells(i, j).Value = mycolor
52
-
53
-
54
-
55
- Select Case mycolor
56
-
57
-
58
-
59
- '赤
60
-
61
- Case 3
62
-
63
- Red_cnt = Red_cnt + 1
64
-
65
-
66
-
67
- '黄色
68
-
69
- Case 6
70
-
71
- yellow_cnt = yellow_cnt + 1
72
-
73
- '黒
74
-
75
- Case 1
76
-
77
- Black_cnt = Black_cnt + 1
78
-
79
-
80
-
81
- End Select
82
-
83
-
84
-
85
- Cells(i, j + 1).Value = Red_cnt
86
-
87
- Cells(i, j + 2).Value = yellow_cnt
88
-
89
- Cells(i, j + 3).Value = Black_cnt
90
-
91
- Next j
92
-
93
- '合計値を初期化
94
-
95
- Red_cnt = 0
96
-
97
- yellow_cnt = 0
98
-
99
- Black_cnt = 0
100
-
101
- Next i
102
-
103
-
104
-
105
- End Sub
106
-
107
-
108
-
109
- ```

15

こちらかがいいかも

2020/08/03 10:23

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1 +1,109 @@
1
- 何度も修正してすみません。いったんなしとします。
1
+ 行ごとの集計ということで、何度も修正して申し訳ありません。
2
+
3
+ 何かおかしかったら教えてください。
4
+
5
+
6
+
7
+ ```VBA
8
+
9
+ Sub 色をカウント()
10
+
11
+
12
+
13
+ Dim Red_cnt As Long
14
+
15
+ Dim yellow_cnt As Long
16
+
17
+ Dim Black_cnt As Long
18
+
19
+ Dim i As Long
20
+
21
+ Dim j As Long
22
+
23
+ Dim mycolor As Integer
24
+
25
+
26
+
27
+ '合計用見出し追加
28
+
29
+
30
+
31
+ Cells(1, 10).Value = "赤"
32
+
33
+ Cells(1, 11).Value = "黄色"
34
+
35
+ Cells(1, 12).Value = "黒"
36
+
37
+
38
+
39
+
40
+
41
+ For i = 2 To 6
42
+
43
+ For j = 2 To 9
44
+
45
+
46
+
47
+ mycolor = Cells(i, j).Interior.ColorIndex
48
+
49
+
50
+
51
+ Cells(i, j).Value = mycolor
52
+
53
+
54
+
55
+ Select Case mycolor
56
+
57
+
58
+
59
+ '赤
60
+
61
+ Case 3
62
+
63
+ Red_cnt = Red_cnt + 1
64
+
65
+
66
+
67
+ '黄色
68
+
69
+ Case 6
70
+
71
+ yellow_cnt = yellow_cnt + 1
72
+
73
+ '黒
74
+
75
+ Case 1
76
+
77
+ Black_cnt = Black_cnt + 1
78
+
79
+
80
+
81
+ End Select
82
+
83
+
84
+
85
+ Cells(i, j + 1).Value = Red_cnt
86
+
87
+ Cells(i, j + 2).Value = yellow_cnt
88
+
89
+ Cells(i, j + 3).Value = Black_cnt
90
+
91
+ Next j
92
+
93
+ '合計値を初期化
94
+
95
+ Red_cnt = 0
96
+
97
+ yellow_cnt = 0
98
+
99
+ Black_cnt = 0
100
+
101
+ Next i
102
+
103
+
104
+
105
+ End Sub
106
+
107
+
108
+
109
+ ```

14

削除

2020/08/03 10:17

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,101 +1 @@
1
- こういう感じでしょうか・・・。各セルには検証用に色番号が入るようにしています。
2
-
3
- 検証しやすいよう、少し修正しております。
1
+ 何度も修正してすみません。いったんなしとします。
4
-
5
- 黒は2（2は白？）ではなく、1としています。
6
-
7
-
8
-
9
-
10
-
11
- ```VBA
12
-
13
-
14
-
15
-
16
-
17
- Sub 色をカウント()
18
-
19
-
20
-
21
- Dim Red_cnt As Long
22
-
23
- Dim yellow_cnt As Long
24
-
25
- Dim Black_cnt As Long
26
-
27
- Dim i As Long
28
-
29
- Dim j As Long
30
-
31
- Dim mycolor as integer
32
-
33
-
34
-
35
- For i = 2 To 6
36
-
37
- For j = 2 To 9
38
-
39
-
40
-
41
- mycolor = Cells(i, j).Interior.ColorIndex
42
-
43
-
44
-
45
- Cells(i, j).Value = mycolor　'色判定の過程がわかるよう評価セルに色番号を入力
46
-
47
-
48
-
49
- Select Case mycolor
50
-
51
-
52
-
53
- '赤
54
-
55
- Case 3
56
-
57
- Red_cnt = Red_cnt + 1
58
-
59
-
60
-
61
- '黄色
62
-
63
- Case 6
64
-
65
- yellow_cnt = yellow_cnt + 1
66
-
67
- '黒
68
-
69
- Case 1
70
-
71
- Black_cnt = Black_cnt + 1
72
-
73
-
74
-
75
- End Select
76
-
77
-
78
-
79
- Next j
80
-
81
- Next i
82
-
83
-
84
-
85
- Cells(2, 11).Value = "赤"
86
-
87
- Cells(2, 12).Value = "黄色"
88
-
89
- Cells(2, 13).Value = "黒"
90
-
91
-
92
-
93
- Cells(3, 11).Value = Red_cnt '赤
94
-
95
- Cells(3, 12).Value = yellow_cnt '黄色
96
-
97
- Cells(3, 13).Value = Black_cnt '　黒
98
-
99
- End Sub
100
-
101
- ```

13

こちらかがいいかも

2020/08/03 10:07

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -28,7 +28,7 @@
28
28
 
29
29
  Dim j As Long
30
30
 
31
-
31
+ Dim mycolor as integer
32
32
 
33
33
 
34
34
 

12

こちらかがいいかも

2020/08/03 10:03

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -42,7 +42,7 @@
42
42
 
43
43
 
44
44
 
45
- Cells(i, j).Value = mycolor
45
+ Cells(i, j).Value = mycolor　'色判定の過程がわかるよう評価セルに色番号を入力
46
46
 
47
47
 
48
48
 

11

こちらかがいいかも

2020/08/03 09:59

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -76,9 +76,9 @@
76
76
 
77
77
 
78
78
 
79
- Next
79
+ Next j
80
80
 
81
- Next
81
+ Next i
82
82
 
83
83
 
84
84
 

10

こちらかがいいかも

2020/08/03 09:53

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,6 +1,8 @@
1
1
  こういう感じでしょうか・・・。各セルには検証用に色番号が入るようにしています。
2
2
 
3
3
  検証しやすいよう、少し修正しております。
4
+
5
+ 黒は2（2は白？）ではなく、1としています。
4
6
 
5
7
 
6
8
 

9

こちらかがいいかも

2020/08/03 09:52

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,16 +1,14 @@
1
- こういう感じでしょうか・・・。各セルには色番号が入るようにしています。
1
+ こういう感じでしょうか・・・。各セルには検証用に色番号が入るようにしています。
2
2
 
3
3
  検証しやすいよう、少し修正しております。
4
-
5
-
6
-
7
- すみません。B1～I16としてしまいました・・。
8
4
 
9
5
 
10
6
 
11
7
 
12
8
 
13
9
  ```VBA
10
+
11
+
14
12
 
15
13
 
16
14
 
@@ -28,11 +26,11 @@
28
26
 
29
27
  Dim j As Long
30
28
 
31
- Dim mycolor as integer
32
29
 
33
30
 
34
31
 
32
+
35
- For i = 1 To 16
33
+ For i = 2 To 6
36
34
 
37
35
  For j = 2 To 9
38
36
 
@@ -82,22 +80,20 @@
82
80
 
83
81
 
84
82
 
85
- Cells(1, 11).Value = "赤"
83
+ Cells(2, 11).Value = "赤"
86
84
 
87
- Cells(1, 12).Value = "黄色"
85
+ Cells(2, 12).Value = "黄色"
88
86
 
89
- Cells(1, 13).Value = "黒"
87
+ Cells(2, 13).Value = "黒"
90
88
 
91
89
 
92
90
 
93
- Cells(2, 11).Value = Red_cnt '赤
91
+ Cells(3, 11).Value = Red_cnt '赤
94
92
 
95
- Cells(2, 12).Value = yellow_cnt '黄色
93
+ Cells(3, 12).Value = yellow_cnt '黄色
96
94
 
97
- Cells(2, 13).Value = Black_cnt '　黒
95
+ Cells(3, 13).Value = Black_cnt '　黒
98
96
 
99
97
  End Sub
100
98
 
101
-
102
-
103
99
  ```

8

こちらかがいいかも

2020/08/03 09:49

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,6 +1,10 @@
1
1
  こういう感じでしょうか・・・。各セルには色番号が入るようにしています。
2
2
 
3
3
  検証しやすいよう、少し修正しております。
4
+
5
+
6
+
7
+ すみません。B1～I16としてしまいました・・。
4
8
 
5
9
 
6
10
 

7

こちらかがいいかも

2020/08/03 09:46

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,4 +1,10 @@
1
1
  こういう感じでしょうか・・・。各セルには色番号が入るようにしています。
2
+
3
+ 検証しやすいよう、少し修正しております。
4
+
5
+
6
+
7
+
2
8
 
3
9
  ```VBA
4
10
 
@@ -18,7 +24,7 @@
18
24
 
19
25
  Dim j As Long
20
26
 
21
-
27
+ Dim mycolor as integer
22
28
 
23
29
 
24
30
 

6

こちらかがいいかも

2020/08/03 09:44

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1 +1,93 @@
1
+ こういう感じでしょうか・・・。各セルには色番号が入るようにしています。
2
+
3
+ ```VBA
4
+
5
+
6
+
1
- 一旦削除させて頂きます。
7
+ Sub 色をカウント()
8
+
9
+
10
+
11
+ Dim Red_cnt As Long
12
+
13
+ Dim yellow_cnt As Long
14
+
15
+ Dim Black_cnt As Long
16
+
17
+ Dim i As Long
18
+
19
+ Dim j As Long
20
+
21
+
22
+
23
+
24
+
25
+ For i = 1 To 16
26
+
27
+ For j = 2 To 9
28
+
29
+
30
+
31
+ mycolor = Cells(i, j).Interior.ColorIndex
32
+
33
+
34
+
35
+ Cells(i, j).Value = mycolor
36
+
37
+
38
+
39
+ Select Case mycolor
40
+
41
+
42
+
43
+ '赤
44
+
45
+ Case 3
46
+
47
+ Red_cnt = Red_cnt + 1
48
+
49
+
50
+
51
+ '黄色
52
+
53
+ Case 6
54
+
55
+ yellow_cnt = yellow_cnt + 1
56
+
57
+ '黒
58
+
59
+ Case 1
60
+
61
+ Black_cnt = Black_cnt + 1
62
+
63
+
64
+
65
+ End Select
66
+
67
+
68
+
69
+ Next
70
+
71
+ Next
72
+
73
+
74
+
75
+ Cells(1, 11).Value = "赤"
76
+
77
+ Cells(1, 12).Value = "黄色"
78
+
79
+ Cells(1, 13).Value = "黒"
80
+
81
+
82
+
83
+ Cells(2, 11).Value = Red_cnt '赤
84
+
85
+ Cells(2, 12).Value = yellow_cnt '黄色
86
+
87
+ Cells(2, 13).Value = Black_cnt '　黒
88
+
89
+ End Sub
90
+
91
+
92
+
93
+ ```

5

削除

2020/08/03 09:43

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,39 +1 @@
1
- 少しコードを拝見しましたが
1
+ 一旦削除させて頂きます。
2
-
3
-
4
-
5
- For Each Rng In Cells(i, j)　●ここのループは必要でしょうか・・。
6
-
7
- 　
8
-
9
- Next Rng
10
-
11
-
12
-
13
- ↓
14
-
15
- dim mycolor as string
16
-
17
-
18
-
19
- mycolor = Cells(i, j).Interior.ColorIndex
20
-
21
-
22
-
23
- Select Case mycolr
24
-
25
-
26
-
27
- とかでしょうか・・。
28
-
29
-
30
-
31
- あと、●ループの数があっていないような気がしますが・・。
32
-
33
-
34
-
35
- 黒は1?
36
-
37
-
38
-
39
- Black_cnt = Blackw_cnt + 1　●ここも変数名がおかしい

4

こちらかがいいかも

2020/08/03 09:36

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -2,7 +2,7 @@
2
2
 
3
3
 
4
4
 
5
- For Each Rng In Cells(i, j)　ここのループは必要でしょうか・・。
5
+ For Each Rng In Cells(i, j)　●ここのループは必要でしょうか・・。
6
6
 
7
7
  　
8
8
 
@@ -28,8 +28,12 @@
28
28
 
29
29
 
30
30
 
31
- あと、ループの数があっていないような気がしますが・・。
31
+ あと、●ループの数があっていないような気がしますが・・。
32
32
 
33
33
 
34
34
 
35
35
  黒は1?
36
+
37
+
38
+
39
+ Black_cnt = Blackw_cnt + 1　●ここも変数名がおかしい

3

こちらかがいいかも

2020/08/03 09:31

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -29,3 +29,7 @@
29
29
 
30
30
 
31
31
  あと、ループの数があっていないような気がしますが・・。
32
+
33
+
34
+
35
+ 黒は1?

2

こちらかがいいかも

2020/08/03 09:28

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -25,3 +25,7 @@
25
25
 
26
26
 
27
27
  とかでしょうか・・。
28
+
29
+
30
+
31
+ あと、ループの数があっていないような気がしますが・・。

1

こちらかがいいかも

2020/08/03 09:18

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -2,15 +2,17 @@
2
2
 
3
3
 
4
4
 
5
- For Each Rng In Cells(i, j)　ここ必要でしょうか・・。
5
+ For Each Rng In Cells(i, j)　ここのループは必要でしょうか・・。
6
6
 
7
7
  　
8
8
 
9
- Next Rng ここ必要でしょうか・・。
9
+ Next Rng
10
+
11
+
10
12
 
11
13
  ↓
12
14
 
13
- dim mycolor as stirg
15
+ dim mycolor as string
14
16
 
15
17
 
16
18