質問編集履歴

2

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

2020/11/09 08:52

投稿

halmichi
halmichi

スコア12

test CHANGED
File without changes
test CHANGED
@@ -163,3 +163,115 @@
163
163
 
164
164
 
165
165
  ```
166
+
167
+
168
+
169
+ ```VBA
170
+
171
+ Private Sub CommandButton4_Click()
172
+
173
+ Dim columnCount As Integer
174
+
175
+ columnCount = Cells(1, Columns.Count).End(xlToLeft).Column \ 2
176
+
177
+
178
+
179
+ Dim rowCount As Integer
180
+
181
+ rowCount = Range("A4").Value
182
+
183
+
184
+
185
+ Dim chBCount As Integer 'リハの番号
186
+
187
+ chBCount = rowCount * columnCount
188
+
189
+
190
+
191
+
192
+
193
+ '列チェックボックスをまとめてカウント
194
+
195
+ Dim i As Integer
196
+
197
+ For i = 1 To columnCount
198
+
199
+ ReDim Col_c(i) As collection '列をまとめるコレクションオブジェクトを作って当該チェックボックスを格納*列数
200
+
201
+ Set Col_c(i) = New collection
202
+
203
+
204
+
205
+ Dim j As Integer '格納するチェックボックス番号
206
+
207
+ For j = chBCount + 1 + (i - 1) * rowCount To chBCount + rowCount + (i - 1) * rowCount
208
+
209
+ With Col_c(i)
210
+
211
+ .Add OLEObjects("CheckBox" & j).Object
212
+
213
+ End With
214
+
215
+ Next
216
+
217
+
218
+
219
+ Dim v As Variant
220
+
221
+ Dim dayCount As Integer
222
+
223
+ dayCount = 0
224
+
225
+ For Each v In Col_c(i)
226
+
227
+ If v.Value = True Then
228
+
229
+ dayCount = dayCount + 1
230
+
231
+ End If
232
+
233
+ Next
234
+
235
+
236
+
237
+ If dayCount = 1 Then
238
+
239
+ With Cells(rowCount + 5, i * 2)
240
+
241
+ .Interior.Color = RGB(255, 0, 0)
242
+
243
+ .Font.Color = RGB(255, 255, 255)
244
+
245
+ .Value = dayCount
246
+
247
+ End With
248
+
249
+ ElseIf dayCount > 9 Then
250
+
251
+ With Cells(rowCount + 5, i * 2)
252
+
253
+ .Interior.Color = RGB(0, 255, 255)
254
+
255
+ .Value = dayCount
256
+
257
+ End With
258
+
259
+ Else
260
+
261
+ Cells(rowCount + 5, i * 2).Value = dayCount
262
+
263
+ End If
264
+
265
+
266
+
267
+ Next
268
+
269
+
270
+
271
+
272
+
273
+ End Sub
274
+
275
+
276
+
277
+ ```

1

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

2020/11/09 08:52

投稿

halmichi
halmichi

スコア12

test CHANGED
File without changes
test CHANGED
@@ -90,71 +90,71 @@
90
90
 
91
91
  For i = 1 To columnCount
92
92
 
93
- Dim Col_c As New Collection '列をまとめるコレクションオブジェクトを作って当該チェックボックスを格納*列数
93
+   Dim Col_c As New Collection '列をまとめるコレクションオブジェクトを作って当該チェックボックスを格納*列数
94
94
 
95
95
 
96
96
 
97
- Dim j As Integer '格納するチェックボックス番号
97
+   Dim j As Integer '格納するチェックボックス番号
98
98
 
99
- For j = chBCount + 1 + (i - 1) * rowCount To chBCount + rowCount + (i - 1) * rowCount
99
+    For j = chBCount + 1 + (i - 1) * rowCount To chBCount + rowCount + (i - 1) * rowCount
100
100
 
101
- With Col_c
101
+     With Col_c
102
102
 
103
- .Add "CheckBox" & j
103
+      .Add OleObjects("CheckBox" & j).Object
104
104
 
105
- End With
105
+     End With
106
106
 
107
- Next
107
+    Next
108
108
 
109
109
 
110
110
 
111
- Dim v As Variant
111
+   Dim v As Variant
112
112
 
113
- Dim dayCount As Integer
113
+    Dim dayCount As Integer
114
114
 
115
- dayCount = 0
115
+   dayCount = 0
116
116
 
117
- For Each v In Col_c
117
+    For Each v In Col_c
118
118
 
119
119
 
120
120
 
121
- If v.Value = True Then
121
+     If v.Value = True Then
122
122
 
123
- dayCount = dayCount + 1
123
+      dayCount = dayCount + 1
124
124
 
125
- End If
125
+    End If
126
126
 
127
- Next
127
+    Next
128
128
 
129
129
 
130
130
 
131
- If dayCount = 1 Then
131
+    If dayCount = 1 Then
132
132
 
133
- With Cells(rowCount + 5, i * 2)
133
+      With Cells(rowCount + 5, i * 2)
134
134
 
135
- .Interior.Color = RGB(255, 0, 0)
135
+      .Interior.Color = RGB(255, 0, 0)
136
136
 
137
- .Font.Color = RGB(255, 255, 255)
137
+      .Font.Color = RGB(255, 255, 255)
138
138
 
139
- .Value = dayCount
139
+      .Value = dayCount
140
140
 
141
- End With
141
+     End With
142
142
 
143
- ElseIf dayCount > 9 Then
143
+    ElseIf dayCount > 9 Then
144
144
 
145
- With Cells(rowCount + 5, i * 2)
145
+     With Cells(rowCount + 5, i * 2)
146
146
 
147
- .Interior.Color = RGB(0, 255, 255)
147
+      .Interior.Color = RGB(0, 255, 255)
148
148
 
149
- .Value = dayCount
149
+      .Value = dayCount
150
150
 
151
- End With
151
+     End With
152
152
 
153
- Else
153
+    Else
154
154
 
155
- Cells(rowCount + 5, i * 2).Value = dayCount
155
+     Cells(rowCount + 5, i * 2).Value = dayCount
156
156
 
157
- End If
157
+   End If
158
158
 
159
159
 
160
160