teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

2

直したコードを足しました。

2020/11/09 08:52

投稿

halmichi
halmichi

スコア12

title CHANGED
File without changes
body CHANGED
@@ -80,4 +80,60 @@
80
80
 
81
81
  Next
82
82
 
83
+ ```
84
+
85
+ ```VBA
86
+ Private Sub CommandButton4_Click()
87
+ Dim columnCount As Integer
88
+ columnCount = Cells(1, Columns.Count).End(xlToLeft).Column \ 2
89
+
90
+ Dim rowCount As Integer
91
+ rowCount = Range("A4").Value
92
+
93
+ Dim chBCount As Integer 'リハの番号
94
+ chBCount = rowCount * columnCount
95
+
96
+
97
+ '列チェックボックスをまとめてカウント
98
+ Dim i As Integer
99
+ For i = 1 To columnCount
100
+ ReDim Col_c(i) As collection '列をまとめるコレクションオブジェクトを作って当該チェックボックスを格納*列数
101
+ Set Col_c(i) = New collection
102
+
103
+ Dim j As Integer '格納するチェックボックス番号
104
+ For j = chBCount + 1 + (i - 1) * rowCount To chBCount + rowCount + (i - 1) * rowCount
105
+ With Col_c(i)
106
+ .Add OLEObjects("CheckBox" & j).Object
107
+ End With
108
+ Next
109
+
110
+ Dim v As Variant
111
+ Dim dayCount As Integer
112
+ dayCount = 0
113
+ For Each v In Col_c(i)
114
+ If v.Value = True Then
115
+ dayCount = dayCount + 1
116
+ End If
117
+ Next
118
+
119
+ If dayCount = 1 Then
120
+ With Cells(rowCount + 5, i * 2)
121
+ .Interior.Color = RGB(255, 0, 0)
122
+ .Font.Color = RGB(255, 255, 255)
123
+ .Value = dayCount
124
+ End With
125
+ ElseIf dayCount > 9 Then
126
+ With Cells(rowCount + 5, i * 2)
127
+ .Interior.Color = RGB(0, 255, 255)
128
+ .Value = dayCount
129
+ End With
130
+ Else
131
+ Cells(rowCount + 5, i * 2).Value = dayCount
132
+ End If
133
+
134
+ Next
135
+
136
+
137
+ End Sub
138
+
83
139
  ```

1

インデントのスペースを多くしました。Collectionオブジェクトに格納するものが文字列になってしまっていたので修正しました。

2020/11/09 08:52

投稿

halmichi
halmichi

スコア12

title CHANGED
File without changes
body CHANGED
@@ -44,39 +44,39 @@
44
44
  '列チェックボックスをまとめてカウント
45
45
  Dim i As Integer
46
46
  For i = 1 To columnCount
47
- Dim Col_c As New Collection '列をまとめるコレクションオブジェクトを作って当該チェックボックスを格納*列数
47
+   Dim Col_c As New Collection '列をまとめるコレクションオブジェクトを作って当該チェックボックスを格納*列数
48
48
 
49
- Dim j As Integer '格納するチェックボックス番号
49
+   Dim j As Integer '格納するチェックボックス番号
50
- For j = chBCount + 1 + (i - 1) * rowCount To chBCount + rowCount + (i - 1) * rowCount
50
+    For j = chBCount + 1 + (i - 1) * rowCount To chBCount + rowCount + (i - 1) * rowCount
51
- With Col_c
51
+     With Col_c
52
- .Add "CheckBox" & j
52
+      .Add OleObjects("CheckBox" & j).Object
53
- End With
53
+     End With
54
- Next
54
+    Next
55
55
 
56
- Dim v As Variant
56
+   Dim v As Variant
57
- Dim dayCount As Integer
57
+    Dim dayCount As Integer
58
- dayCount = 0
58
+   dayCount = 0
59
- For Each v In Col_c
59
+    For Each v In Col_c
60
60
 
61
- If v.Value = True Then
61
+     If v.Value = True Then
62
- dayCount = dayCount + 1
62
+      dayCount = dayCount + 1
63
- End If
63
+    End If
64
- Next
64
+    Next
65
65
 
66
- If dayCount = 1 Then
66
+    If dayCount = 1 Then
67
- With Cells(rowCount + 5, i * 2)
67
+      With Cells(rowCount + 5, i * 2)
68
- .Interior.Color = RGB(255, 0, 0)
68
+      .Interior.Color = RGB(255, 0, 0)
69
- .Font.Color = RGB(255, 255, 255)
69
+      .Font.Color = RGB(255, 255, 255)
70
- .Value = dayCount
70
+      .Value = dayCount
71
- End With
71
+     End With
72
- ElseIf dayCount > 9 Then
72
+    ElseIf dayCount > 9 Then
73
- With Cells(rowCount + 5, i * 2)
73
+     With Cells(rowCount + 5, i * 2)
74
- .Interior.Color = RGB(0, 255, 255)
74
+      .Interior.Color = RGB(0, 255, 255)
75
- .Value = dayCount
75
+      .Value = dayCount
76
- End With
76
+     End With
77
- Else
77
+    Else
78
- Cells(rowCount + 5, i * 2).Value = dayCount
78
+     Cells(rowCount + 5, i * 2).Value = dayCount
79
- End If
79
+   End If
80
80
 
81
81
  Next
82
82