回答編集履歴
5
修正
test
CHANGED
@@ -1,687 +1,537 @@
|
|
1
|
-
|
2
|
-
|
3
|
-
|
4
|
-
|
5
|
-
|
6
|
-
|
7
|
-
|
8
|
-
|
9
|
-
|
10
|
-
|
11
|
-
|
12
|
-
|
13
|
-
|
14
|
-
|
15
|
-
|
16
|
-
|
17
|
-
|
18
|
-
|
19
|
-
|
20
|
-
|
21
|
-
|
22
|
-
|
23
|
-
|
24
|
-
|
25
|
-
|
26
|
-
|
27
|
-
|
1
|
+
例えば、
|
2
|
+
|
3
|
+
自ブック(マクロを仕込むブック)に、
|
4
|
+
|
5
|
+
日報
|
6
|
+
|
7
|
+
集計表
|
8
|
+
|
9
|
+
作業用
|
10
|
+
|
11
|
+
の3つのシートがあるとします。
|
12
|
+
|
13
|
+
そして日報シートに、
|
14
|
+
|
15
|
+
|
16
|
+
|
17
|
+
```ここに言語を入力
|
18
|
+
|
19
|
+
日付 場所 氏名 執務時間
|
20
|
+
|
21
|
+
|
22
|
+
|
23
|
+
2020.7.1 事務所 織田 信長 7
|
24
|
+
|
25
|
+
|
26
|
+
|
27
|
+
2020.7.5 事務所 明智 光秀 2.5
|
28
|
+
|
29
|
+
|
30
|
+
|
31
|
+
2020.7.9 本社 織田 信長 3.5
|
32
|
+
|
33
|
+
|
34
|
+
|
35
|
+
2020.7.13 本社 千 利休 1
|
36
|
+
|
37
|
+
|
38
|
+
|
39
|
+
2020.7.17 本社 徳川 家康 5
|
40
|
+
|
41
|
+
|
42
|
+
|
43
|
+
2020.7.21 子会社 武田 信玄 7
|
44
|
+
|
45
|
+
|
46
|
+
|
47
|
+
2020.7.25 支店・営業所 織田 信長 2.5
|
48
|
+
|
49
|
+
|
50
|
+
|
51
|
+
2020.7.29 事務所 明智 光秀 3.5
|
52
|
+
|
53
|
+
|
54
|
+
|
55
|
+
2020.8.2 事務所 織田 信長 1
|
56
|
+
|
57
|
+
|
58
|
+
|
59
|
+
2020.8.6 事務所 千 利休 5
|
60
|
+
|
61
|
+
|
62
|
+
|
63
|
+
2020.8.10 本社 徳川 家康 7
|
64
|
+
|
65
|
+
|
66
|
+
|
67
|
+
2020.8.14 本社 武田 信玄 2.5
|
68
|
+
|
69
|
+
|
70
|
+
|
71
|
+
2020.8.18 本社 織田 信長 3.5
|
72
|
+
|
73
|
+
|
74
|
+
|
75
|
+
2020.8.22 子会社 明智 光秀 1
|
76
|
+
|
77
|
+
|
78
|
+
|
79
|
+
2020.8.26 支店・営業所 織田 信長 5
|
80
|
+
|
81
|
+
|
82
|
+
|
83
|
+
2020.8.30 本社 千 利休 7
|
84
|
+
|
85
|
+
|
86
|
+
|
87
|
+
2020.9.3 子会社 徳川 家康 2.5
|
88
|
+
|
89
|
+
|
90
|
+
|
91
|
+
2020.9.7 支店・営業所 武田 信玄 3.5
|
92
|
+
|
93
|
+
```
|
94
|
+
|
95
|
+
|
96
|
+
|
97
|
+
というようなデータがあるとして、
|
98
|
+
|
99
|
+
|
100
|
+
|
101
|
+
以下のようなコードで、
|
102
|
+
|
103
|
+
自分好みの表(そちらの希望に沿ってはいません。)を作ることが可能です。
|
104
|
+
|
105
|
+
あとの表示の順番や、列の具合、抽出したい月とかはそちらの希望するよう加工編集してください。
|
106
|
+
|
107
|
+
|
108
|
+
|
109
|
+
他人が書いたコードは解読するのに苦労するとは思いますが、
|
110
|
+
|
111
|
+
参考になれば。
|
112
|
+
|
113
|
+
|
114
|
+
|
115
|
+
参考サイト>>
|
116
|
+
|
117
|
+
[構造化プログラミングに挑戦しよう!](http://home.att.ne.jp/zeta/gen/excel/c03p06.htm)
|
118
|
+
|
119
|
+
[仕様要件からコードの組み立てを考える。](http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_160.html)
|
120
|
+
|
121
|
+
|
122
|
+
|
123
|
+
他にもいいサイトがある気がします。
|
124
|
+
|
125
|
+
探してみてください。
|
126
|
+
|
127
|
+
※文字数制限に引っかかったため、一部削除しました。
|
28
128
|
|
29
129
|
---
|
30
130
|
|
31
|
-
|
32
|
-
|
33
|
-
|
34
|
-
|
35
|
-
|
36
|
-
|
37
|
-
|
38
|
-
|
39
|
-
|
40
|
-
|
41
|
-
|
42
|
-
|
43
|
-
|
44
|
-
|
45
|
-
|
46
|
-
|
47
|
-
|
48
|
-
|
49
|
-
|
50
|
-
|
51
|
-
w
|
52
|
-
|
53
|
-
|
54
|
-
|
55
|
-
|
56
|
-
|
57
|
-
|
58
|
-
|
59
|
-
|
60
|
-
|
61
|
-
|
62
|
-
|
63
|
-
|
64
|
-
|
65
|
-
|
66
|
-
|
67
|
-
|
68
|
-
|
69
|
-
|
70
|
-
|
71
|
-
|
72
|
-
|
73
|
-
|
74
|
-
|
75
|
-
|
76
|
-
|
77
|
-
|
78
|
-
|
79
|
-
|
80
|
-
|
81
|
-
|
82
|
-
|
83
|
-
|
84
|
-
|
85
|
-
|
86
|
-
|
87
|
-
|
88
|
-
|
89
|
-
|
90
|
-
|
91
|
-
|
92
|
-
|
93
|
-
|
94
|
-
|
95
|
-
|
96
|
-
|
97
|
-
|
98
|
-
|
99
|
-
|
100
|
-
|
101
|
-
|
102
|
-
|
103
|
-
|
104
|
-
|
105
|
-
|
106
|
-
|
107
|
-
|
108
|
-
|
109
|
-
|
110
|
-
|
111
|
-
|
112
|
-
|
113
|
-
|
114
|
-
|
115
|
-
|
116
|
-
|
117
|
-
|
118
|
-
|
119
|
-
|
120
|
-
|
121
|
-
|
122
|
-
|
123
|
-
|
124
|
-
|
125
|
-
|
126
|
-
|
127
|
-
|
128
|
-
|
129
|
-
|
130
|
-
|
131
|
-
|
132
|
-
|
133
|
-
|
134
|
-
|
135
|
-
|
136
|
-
|
137
|
-
|
138
|
-
|
139
|
-
|
140
|
-
|
141
|
-
|
142
|
-
|
143
|
-
|
144
|
-
|
145
|
-
|
146
|
-
|
147
|
-
|
148
|
-
|
149
|
-
|
150
|
-
|
151
|
-
の
|
152
|
-
|
153
|
-
|
154
|
-
|
155
|
-
|
156
|
-
|
157
|
-
|
158
|
-
|
159
|
-
|
160
|
-
|
161
|
-
|
162
|
-
|
163
|
-
|
164
|
-
|
165
|
-
|
166
|
-
|
167
|
-
|
168
|
-
|
169
|
-
|
170
|
-
|
171
|
-
|
172
|
-
|
173
|
-
|
174
|
-
|
175
|
-
|
176
|
-
|
177
|
-
|
178
|
-
|
179
|
-
|
180
|
-
|
181
|
-
|
182
|
-
|
183
|
-
|
184
|
-
|
185
|
-
|
186
|
-
|
187
|
-
|
188
|
-
|
189
|
-
|
190
|
-
|
191
|
-
|
192
|
-
|
193
|
-
|
194
|
-
|
195
|
-
|
196
|
-
|
197
|
-
|
198
|
-
|
199
|
-
|
200
|
-
|
201
|
-
|
202
|
-
|
203
|
-
|
204
|
-
|
205
|
-
|
206
|
-
|
207
|
-
|
208
|
-
|
209
|
-
|
210
|
-
|
211
|
-
|
212
|
-
|
213
|
-
|
214
|
-
|
215
|
-
|
216
|
-
|
217
|
-
|
218
|
-
|
219
|
-
|
220
|
-
|
221
|
-
|
222
|
-
|
223
|
-
|
224
|
-
|
225
|
-
|
226
|
-
|
227
|
-
|
228
|
-
|
229
|
-
|
230
|
-
|
231
|
-
|
131
|
+
コードを修正しました。
|
132
|
+
|
133
|
+
コンパイルはしてみましたが、
|
134
|
+
|
135
|
+
動作確認はしてません。
|
136
|
+
|
137
|
+
参考になれば。
|
138
|
+
|
139
|
+
|
140
|
+
|
141
|
+
```ExcelVBA
|
142
|
+
|
143
|
+
'ピボットテーブルを使った集計サンプル Ver.0.90
|
144
|
+
|
145
|
+
Option Explicit
|
146
|
+
|
147
|
+
|
148
|
+
|
149
|
+
Sub メイン()
|
150
|
+
|
151
|
+
Dim wshData As Worksheet
|
152
|
+
|
153
|
+
Dim wshResult As Worksheet
|
154
|
+
|
155
|
+
|
156
|
+
|
157
|
+
Set wshData = Worksheets("日報")
|
158
|
+
|
159
|
+
Set wshResult = Worksheets("集計")
|
160
|
+
|
161
|
+
集計 wshData, wshResult, "日付", "氏名,場所"
|
162
|
+
|
163
|
+
集計 wshData, wshResult, "場所", "氏名", False
|
164
|
+
|
165
|
+
End Sub
|
166
|
+
|
167
|
+
|
168
|
+
|
169
|
+
Private Sub 集計( _
|
170
|
+
|
171
|
+
ByRef wshOld As Worksheet, _
|
172
|
+
|
173
|
+
ByRef wshNew As Worksheet, _
|
174
|
+
|
175
|
+
ByVal strSideItem As String, _
|
176
|
+
|
177
|
+
ByVal strTopItem As String, _
|
178
|
+
|
179
|
+
Optional ByVal flg As Boolean = True)
|
180
|
+
|
181
|
+
Dim rngTopleft As Range
|
182
|
+
|
183
|
+
Dim pvtMyTable As PivotTable
|
184
|
+
|
185
|
+
|
186
|
+
|
187
|
+
'ピボットテーブルで集計
|
188
|
+
|
189
|
+
Set pvtMyTable = GetResult(wshOld, strSideItem, strTopItem)
|
190
|
+
|
191
|
+
'書き出し位置の取得
|
192
|
+
|
193
|
+
Set rngTopleft = GetTopLeft(wshNew, flg)
|
194
|
+
|
195
|
+
'集計結果を様式に沿って出力
|
196
|
+
|
197
|
+
ResultOutput pvtMyTable, rngTopleft, flg
|
198
|
+
|
199
|
+
End Sub
|
200
|
+
|
201
|
+
|
202
|
+
|
203
|
+
'ピボットテーブルで集計
|
204
|
+
|
205
|
+
Private Function GetResult( _
|
206
|
+
|
207
|
+
ByRef wshSource As Worksheet, _
|
208
|
+
|
209
|
+
ByVal strSideItem As String, _
|
210
|
+
|
211
|
+
ByVal strTopItem As String) As PivotTable
|
212
|
+
|
213
|
+
Dim pvtCache As PivotCache
|
214
|
+
|
215
|
+
Dim pvtTable As PivotTable
|
216
|
+
|
217
|
+
Dim f As PivotField
|
218
|
+
|
219
|
+
Dim rngSourceData As Range
|
220
|
+
|
221
|
+
Dim rngWorkCellRange As Range
|
222
|
+
|
223
|
+
Dim v As Variant
|
224
|
+
|
225
|
+
Dim wsh As Workbook
|
226
|
+
|
227
|
+
|
228
|
+
|
229
|
+
'セル範囲、ピボットテーブルの取得
|
230
|
+
|
231
|
+
Set wsh = ThisWorkbook.Worksheets("作業用")
|
232
|
+
|
233
|
+
Set rngSourceData = wshSource.UsedRange
|
234
|
+
|
235
|
+
On Error GoTo ErrHandler
|
236
|
+
|
237
|
+
Set pvtTable = wsh.PivotTables(1)
|
238
|
+
|
239
|
+
On Error GoTo 0
|
240
|
+
|
241
|
+
|
242
|
+
|
243
|
+
'ピボットテーブルでの集計
|
244
|
+
|
245
|
+
With pvtTable
|
246
|
+
|
247
|
+
'初期化
|
248
|
+
|
249
|
+
.ClearTable
|
250
|
+
|
251
|
+
'項目の配置
|
252
|
+
|
253
|
+
.PivotFields(strSideItem).Orientation = xlRowField
|
254
|
+
|
255
|
+
For Each v In Split(strTopItem, ",")
|
256
|
+
|
257
|
+
.PivotFields(v).Orientation = xlColumnField
|
258
|
+
|
259
|
+
Next
|
260
|
+
|
261
|
+
.AddDataField .PivotFields("執務時間")
|
262
|
+
|
263
|
+
'小計行の非表示化
|
264
|
+
|
265
|
+
For Each f In .PivotFields
|
266
|
+
|
267
|
+
f.Subtotals(1) = False
|
268
|
+
|
269
|
+
Next
|
270
|
+
|
271
|
+
End With
|
272
|
+
|
273
|
+
|
274
|
+
|
275
|
+
'返り値のセット
|
276
|
+
|
277
|
+
Set GetResult = pvtTable
|
278
|
+
|
279
|
+
|
280
|
+
|
281
|
+
Exit Function
|
282
|
+
|
283
|
+
|
284
|
+
|
285
|
+
'エラー回避処理(ピボットテーブルがシート上に未作成の場合は新規に作成)
|
286
|
+
|
287
|
+
ErrHandler:
|
288
|
+
|
289
|
+
Set pvtCache = wsh.Parent.PivotCaches.Create( _
|
290
|
+
|
291
|
+
SourceType:=xlDatabase, _
|
292
|
+
|
293
|
+
SourceData:=rngSourceData)
|
294
|
+
|
295
|
+
Set rngWorkCellRange = wsh.Range("A1")
|
296
|
+
|
297
|
+
Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=rngWorkCellRange)
|
298
|
+
|
299
|
+
Resume Next
|
300
|
+
|
301
|
+
End Function
|
302
|
+
|
303
|
+
|
304
|
+
|
305
|
+
'書出し位置の取得
|
306
|
+
|
307
|
+
Private Function GetTopLeft( _
|
308
|
+
|
309
|
+
ByRef wsh As Worksheet, _
|
310
|
+
|
311
|
+
ByVal flg As Boolean) As Range
|
312
|
+
|
313
|
+
Dim c As Range
|
314
|
+
|
315
|
+
|
316
|
+
|
317
|
+
With wsh.UsedRange
|
318
|
+
|
319
|
+
If flg Then
|
320
|
+
|
321
|
+
.Clear
|
322
|
+
|
323
|
+
Set c = .Cells(1)
|
324
|
+
|
325
|
+
Else
|
326
|
+
|
327
|
+
Set c = .Cells(Rows.Count + 1, 1)
|
328
|
+
|
329
|
+
End If
|
330
|
+
|
331
|
+
End With
|
332
|
+
|
333
|
+
Set GetTopLeft = c
|
334
|
+
|
335
|
+
End Function
|
336
|
+
|
337
|
+
|
338
|
+
|
339
|
+
'集計結果を様式に沿って出力
|
340
|
+
|
341
|
+
Private Sub ResultOutput( _
|
342
|
+
|
343
|
+
ByRef pvtTable As PivotTable, _
|
344
|
+
|
345
|
+
ByRef rngCopyTo As Range, _
|
346
|
+
|
347
|
+
ByVal flg As Boolean)
|
348
|
+
|
349
|
+
|
350
|
+
|
351
|
+
'表頭の作成
|
352
|
+
|
353
|
+
If flg Then
|
354
|
+
|
355
|
+
Set表頭 pvtTable.TableRange1.Rows(2), rngCopyTo
|
356
|
+
|
357
|
+
End If
|
358
|
+
|
359
|
+
'表側の作成
|
360
|
+
|
361
|
+
Set表側 pvtTable.RowRange, rngCopyTo.Offset(1)
|
362
|
+
|
363
|
+
'表体の作成
|
364
|
+
|
365
|
+
Set表体 pvtTable.DataBodyRange, rngCopyTo.Offset(1, 1), flg
|
366
|
+
|
367
|
+
|
368
|
+
|
369
|
+
'列幅をオートフィット
|
370
|
+
|
371
|
+
rngCopyTo.CurrentRegion.EntireColumn.AutoFit
|
372
|
+
|
373
|
+
End Sub
|
374
|
+
|
375
|
+
|
376
|
+
|
377
|
+
'*******************************************
|
378
|
+
|
379
|
+
'表頭の作成
|
380
|
+
|
381
|
+
'第一引数 rngFrom:転記元のセル範囲(Range)
|
382
|
+
|
383
|
+
'第二引数 rngTo:転記先のセル範囲(Range)
|
384
|
+
|
385
|
+
'******************************************
|
386
|
+
|
387
|
+
Private Sub Set表頭(ByRef rngFrom As Range, ByRef rngTo As Range)
|
388
|
+
|
389
|
+
Dim v As Variant
|
390
|
+
|
391
|
+
Dim ix As Long
|
392
|
+
|
393
|
+
|
394
|
+
|
395
|
+
'元のセル範囲の値を一次配列で取得
|
396
|
+
|
397
|
+
'(ワークシート上の関数はセル範囲を与える仕様だが、
|
398
|
+
|
399
|
+
'配列も受け取れる関数があるので値(Value)を与えてもよい。)
|
400
|
+
|
401
|
+
With WorksheetFunction
|
402
|
+
|
403
|
+
v = .Transpose(.Transpose(rngFrom.Cells))
|
404
|
+
|
405
|
+
End With
|
406
|
+
|
407
|
+
|
408
|
+
|
409
|
+
'それぞれの値の加工
|
410
|
+
|
411
|
+
For ix = LBound(v) To UBound(v)
|
412
|
+
|
413
|
+
If ix = 1 Then
|
414
|
+
|
415
|
+
v(ix) = "日付"
|
416
|
+
|
417
|
+
Else
|
418
|
+
|
419
|
+
'空白でないなら
|
420
|
+
|
421
|
+
If Len(v(ix)) > 0 Then
|
422
|
+
|
423
|
+
'スペース文字で文字列を分割し最初の値を再設定
|
424
|
+
|
425
|
+
v(ix) = Split(v(ix), " ")(0)
|
426
|
+
|
427
|
+
End If
|
428
|
+
|
429
|
+
End If
|
430
|
+
|
431
|
+
Next
|
432
|
+
|
433
|
+
'シート上へ転記
|
434
|
+
|
435
|
+
With rngTo.Resize(, rngFrom.Columns.Count)
|
436
|
+
|
437
|
+
.Value = v
|
438
|
+
|
439
|
+
'選択範囲内で中央に配置の設定
|
440
|
+
|
441
|
+
.HorizontalAlignment = xlCenterAcrossSelection
|
442
|
+
|
443
|
+
End With
|
444
|
+
|
445
|
+
End Sub
|
446
|
+
|
447
|
+
|
448
|
+
|
449
|
+
'******************************
|
450
|
+
|
451
|
+
'表側の作成
|
452
|
+
|
453
|
+
'***********************
|
454
|
+
|
455
|
+
Private Sub Set表側(ByRef rngFrom As Range, ByRef rngTo As Range)
|
456
|
+
|
457
|
+
rngTo.Resize(rngFrom.Rows.Count - 1).Value = rngFrom.Offset(1).Value
|
458
|
+
|
459
|
+
End Sub
|
460
|
+
|
461
|
+
|
462
|
+
|
463
|
+
'**********************************
|
464
|
+
|
465
|
+
'表体の作成
|
466
|
+
|
467
|
+
'第一引数 rngFrom:転記元セル範囲(Range)
|
468
|
+
|
469
|
+
'第二引数 rngTo:転記先セル範囲(Range)
|
470
|
+
|
471
|
+
'第三引数 flg:データに項目(略称)を付加するかどうかのフラグ(Boolean)
|
472
|
+
|
473
|
+
'*************************************
|
474
|
+
|
475
|
+
Private Sub Set表体(ByRef rngFrom As Range, _
|
476
|
+
|
477
|
+
ByRef rngTo As Range, _
|
478
|
+
|
479
|
+
ByVal flg As Boolean)
|
480
|
+
|
481
|
+
Dim vv As Variant
|
482
|
+
|
483
|
+
Dim v As Variant
|
484
|
+
|
485
|
+
Dim ixH As Long
|
486
|
+
|
487
|
+
Dim ixV As Long
|
488
|
+
|
489
|
+
|
490
|
+
|
491
|
+
'値を2次元配列変数で取得
|
492
|
+
|
493
|
+
vv = rngFrom.Value
|
494
|
+
|
495
|
+
'略称の付加
|
496
|
+
|
497
|
+
If flg Then
|
498
|
+
|
499
|
+
'略称の元を一次配列で取得
|
500
|
+
|
501
|
+
With WorksheetFunction
|
502
|
+
|
503
|
+
v = .Transpose(.Transpose(rngFrom.Rows(0).Cells))
|
504
|
+
|
505
|
+
End With
|
506
|
+
|
507
|
+
'それぞれの値を巡回し、値に略称をくっつけていく
|
508
|
+
|
509
|
+
For ixH = LBound(vv, 1) To UBound(vv, 1)
|
510
|
+
|
511
|
+
For ixV = LBound(vv, 2) To UBound(vv, 2)
|
512
|
+
|
513
|
+
If IsEmpty(vv(ixH, ixV)) = False Then
|
514
|
+
|
515
|
+
vv(ixH, ixV) = Left(v(ixV), 1) & vv(ixH, ixV)
|
516
|
+
|
517
|
+
End If
|
518
|
+
|
519
|
+
Next
|
520
|
+
|
521
|
+
Next
|
522
|
+
|
523
|
+
End If
|
524
|
+
|
525
|
+
'転記先に転記
|
526
|
+
|
527
|
+
rngTo.Resize(rngFrom.Rows.Count, rngFrom.Columns.Count).Value = vv
|
528
|
+
|
529
|
+
End Sub
|
232
530
|
|
233
531
|
```
|
234
532
|
|
235
|
-
|
236
|
-
|
237
|
-
というようなデータがあるとして、
|
238
|
-
|
239
|
-
|
240
|
-
|
241
|
-
以下のようなコードで、
|
242
|
-
|
243
|
-
自分好みの表(そちらの希望に沿ってはいません。)を作ることが可能です。
|
244
|
-
|
245
|
-
あとの表示の順番や、列の具合、抽出したい月とかはそちらの希望するよう加工編集してください。
|
246
|
-
|
247
|
-
|
248
|
-
|
249
|
-
```ExcelVBA
|
250
|
-
|
251
|
-
'***********************
|
252
|
-
|
253
|
-
'ピボットテーブルを使った自分好みのクロス集計表を作成するサンプル
|
254
|
-
|
255
|
-
'作成者:mattuwan
|
256
|
-
|
257
|
-
'※著作権は放棄しますです。自己責任で使用・改変してください。
|
258
|
-
|
259
|
-
'※エラー回避処理は万全ではないかもしれません。(バグがあるかも?)
|
260
|
-
|
261
|
-
'*************************
|
262
|
-
|
263
|
-
Option Explicit
|
264
|
-
|
265
|
-
|
266
|
-
|
267
|
-
'********************************
|
268
|
-
|
269
|
-
'集計表シートにクロス集計表を2つ作成
|
270
|
-
|
271
|
-
'***********************************
|
272
|
-
|
273
|
-
Sub Main()
|
274
|
-
|
275
|
-
Dim rngWritingPosition As Range
|
276
|
-
|
277
|
-
|
278
|
-
|
279
|
-
Set rngWritingPosition = Worksheets("集計表").Range("A1")
|
280
|
-
|
281
|
-
Get表作成 "日付", "氏名,場所", rngWritingPosition
|
282
|
-
|
283
|
-
|
284
|
-
|
285
|
-
With rngWritingPosition.CurrentRegion
|
286
|
-
|
287
|
-
Set rngWritingPosition = .Cells(1).Offset(.Rows.Count)
|
288
|
-
|
289
|
-
End With
|
290
|
-
|
291
|
-
Get表作成 "場所", "氏名", rngWritingPosition, False
|
292
|
-
|
293
|
-
End Sub
|
294
|
-
|
295
|
-
|
296
|
-
|
297
|
-
'*************************************
|
298
|
-
|
299
|
-
'表側及び表頭の項目を指定して集計し集計表の指定したセルに結果を挿入
|
300
|
-
|
301
|
-
'第一引数 strSideItem:表側に使う項目(String)
|
302
|
-
|
303
|
-
'第二引数 strTopItem:表頭に使う項目(複数指定する場合はカンマ区切りで指定)(String)
|
304
|
-
|
305
|
-
'第三引数 rngTopLeft:表を作成するセル(左上)の位置を指定(Range)
|
306
|
-
|
307
|
-
'第四引数 flg:表を作成するときにシートの初期化を行うか否かのフラグ(boolean)
|
308
|
-
|
309
|
-
'返り値:作成した表のセル範囲
|
310
|
-
|
311
|
-
'***********************************:
|
312
|
-
|
313
|
-
Private Function Get表作成(ByVal strSideItem As String, _
|
314
|
-
|
315
|
-
ByVal strTopItem As String, _
|
316
|
-
|
317
|
-
ByRef rngTopLeft As Range, _
|
318
|
-
|
319
|
-
Optional ByVal flg As Boolean = True) As Range
|
320
|
-
|
321
|
-
Dim pvtTable As PivotTable
|
322
|
-
|
323
|
-
|
324
|
-
|
325
|
-
'シートの初期化
|
326
|
-
|
327
|
-
If flg Then
|
328
|
-
|
329
|
-
rngTopLeft.Worksheet.UsedRange.Clear
|
330
|
-
|
331
|
-
End If
|
332
|
-
|
333
|
-
|
334
|
-
|
335
|
-
'ピボットテーブルで集計
|
336
|
-
|
337
|
-
Set pvtTable = GetPvt集計(strSideItem, strTopItem)
|
338
|
-
|
339
|
-
|
340
|
-
|
341
|
-
'集計結果を編集して集計用シートに集計表を作成
|
342
|
-
|
343
|
-
Set集計表シートへ転記 rngTopLeft, pvtTable, flg
|
344
|
-
|
345
|
-
|
346
|
-
|
347
|
-
'返り値のセット
|
348
|
-
|
349
|
-
Set Get表作成 = rngTopLeft.CurrentRegion
|
350
|
-
|
351
|
-
End Function
|
352
|
-
|
353
|
-
|
354
|
-
|
355
|
-
'*********************************
|
356
|
-
|
357
|
-
'ピボットテーブルで集計
|
358
|
-
|
359
|
-
'第一引数 strSideItem:表側の項目(String)
|
360
|
-
|
361
|
-
'第二引数 strTopItem:表頭の項目(string)
|
362
|
-
|
363
|
-
'返り値:設定したピボットテーブル
|
364
|
-
|
365
|
-
'*****************************************
|
366
|
-
|
367
|
-
Private Function GetPvt集計(ByVal strSideItem As String, _
|
368
|
-
|
369
|
-
ByVal strTopItem As String) As PivotTable
|
370
|
-
|
371
|
-
Dim pvtCache As PivotCache
|
372
|
-
|
373
|
-
Dim pvtTable As PivotTable
|
374
|
-
|
375
|
-
Dim f As PivotField
|
376
|
-
|
377
|
-
Dim rngSourceData As Range
|
378
|
-
|
379
|
-
Dim rngWorkCellRange As Range
|
380
|
-
|
381
|
-
Dim v As Variant
|
382
|
-
|
383
|
-
Dim wbk As Workbook
|
384
|
-
|
385
|
-
|
386
|
-
|
387
|
-
'セル範囲、ピボットテーブルの取得
|
388
|
-
|
389
|
-
Set wbk = ThisWorkbook
|
390
|
-
|
391
|
-
Set rngSourceData = wbk.Worksheets("日報").Range("A1").CurrentRegion
|
392
|
-
|
393
|
-
On Error GoTo ErrHandler
|
394
|
-
|
395
|
-
Set pvtTable = wbk.Worksheets("作業用").PivotTables(1)
|
396
|
-
|
397
|
-
On Error GoTo 0
|
398
|
-
|
399
|
-
|
400
|
-
|
401
|
-
'ピボットテーブルでの集計
|
402
|
-
|
403
|
-
With pvtTable
|
404
|
-
|
405
|
-
'初期化
|
406
|
-
|
407
|
-
.ClearTable
|
408
|
-
|
409
|
-
'項目の配置
|
410
|
-
|
411
|
-
.PivotFields(strSideItem).Orientation = xlRowField
|
412
|
-
|
413
|
-
For Each v In Split(strTopItem, ",")
|
414
|
-
|
415
|
-
.PivotFields(v).Orientation = xlColumnField
|
416
|
-
|
417
|
-
Next
|
418
|
-
|
419
|
-
.AddDataField .PivotFields("執務時間")
|
420
|
-
|
421
|
-
'小計行の非表示化
|
422
|
-
|
423
|
-
For Each f In .PivotFields
|
424
|
-
|
425
|
-
f.Subtotals(1) = False
|
426
|
-
|
427
|
-
Next
|
428
|
-
|
429
|
-
End With
|
430
|
-
|
431
|
-
|
432
|
-
|
433
|
-
'返り値のセット
|
434
|
-
|
435
|
-
Set GetPvt集計 = pvtTable
|
436
|
-
|
437
|
-
Exit Function
|
438
|
-
|
439
|
-
|
440
|
-
|
441
|
-
'エラー回避処理(ピボットテーブルがシート上に未作成の場合は新規に作成)
|
442
|
-
|
443
|
-
ErrHandler:
|
444
|
-
|
445
|
-
Set pvtCache = wbk.PivotCaches.Create( _
|
446
|
-
|
447
|
-
SourceType:=xlDatabase, _
|
448
|
-
|
449
|
-
SourceData:=rngSourceData)
|
450
|
-
|
451
|
-
Set rngWorkCellRange = wbk.Worksheets("作業用").Range("A1")
|
452
|
-
|
453
|
-
Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=rngWorkCellRange)
|
454
|
-
|
455
|
-
Resume Next
|
456
|
-
|
457
|
-
End Function
|
458
|
-
|
459
|
-
|
460
|
-
|
461
|
-
'**************************************
|
462
|
-
|
463
|
-
'ピボットテーブルでの集計結果を編集して集計表シートに集計表を作成
|
464
|
-
|
465
|
-
'第一引数 rngCopyTo:作成するセルの位置(左上)(Range)
|
466
|
-
|
467
|
-
'第二引数 pvtCopyFrom:集計表の元となるピボットテーブル(PivotTable)
|
468
|
-
|
469
|
-
'第三引数 flg:シートを初期化したかどうかのフラグ、初期化されない場合は表頭を標記しない(Boolean)
|
470
|
-
|
471
|
-
'***************************************
|
472
|
-
|
473
|
-
Private Sub Set集計表シートへ転記(ByRef rngCopyTo As Range, _
|
474
|
-
|
475
|
-
ByRef pvtCopyFrom As PivotTable, _
|
476
|
-
|
477
|
-
ByVal flg As Boolean)
|
478
|
-
|
479
|
-
'表頭の作成
|
480
|
-
|
481
|
-
If flg Then
|
482
|
-
|
483
|
-
Set表頭 pvtCopyFrom.TableRange1.Rows(2), rngCopyTo
|
484
|
-
|
485
|
-
End If
|
486
|
-
|
487
|
-
'表側の作成
|
488
|
-
|
489
|
-
Set表側 pvtCopyFrom.RowRange, rngCopyTo.Offset(1)
|
490
|
-
|
491
|
-
'表体の作成
|
492
|
-
|
493
|
-
Set表体 pvtCopyFrom.DataBodyRange, rngCopyTo.Offset(1, 1), flg
|
494
|
-
|
495
|
-
|
496
|
-
|
497
|
-
'列幅をオートフィット
|
498
|
-
|
499
|
-
rngCopyTo.CurrentRegion.EntireColumn.AutoFit
|
500
|
-
|
501
|
-
End Sub
|
502
|
-
|
503
|
-
|
504
|
-
|
505
|
-
'**************************************
|
506
|
-
|
507
|
-
'表頭の作成
|
508
|
-
|
509
|
-
'第一引数 rngFrom:転記元のセル範囲(Range)
|
510
|
-
|
511
|
-
'第二引数 rngTo:転記先のセル範囲(Range)
|
512
|
-
|
513
|
-
'******************************************
|
514
|
-
|
515
|
-
Private Sub Set表頭(ByRef rngFrom As Range, ByRef rngTo As Range)
|
516
|
-
|
517
|
-
Dim v As Variant
|
518
|
-
|
519
|
-
Dim ix As Long
|
520
|
-
|
521
|
-
|
522
|
-
|
523
|
-
'元のセル範囲の値を一次配列で取得
|
524
|
-
|
525
|
-
'(ワークシート上の関数はセル範囲を与える仕様だが、
|
526
|
-
|
527
|
-
'配列も受け取れる関数があるので値(Value)を与えてもよい。)
|
528
|
-
|
529
|
-
With WorksheetFunction
|
530
|
-
|
531
|
-
v = .Transpose(.Transpose(rngFrom.Cells))
|
532
|
-
|
533
|
-
End With
|
534
|
-
|
535
|
-
|
536
|
-
|
537
|
-
'それぞれの値の加工
|
538
|
-
|
539
|
-
For ix = LBound(v) To UBound(v)
|
540
|
-
|
541
|
-
If ix = 1 Then
|
542
|
-
|
543
|
-
v(ix) = "日付"
|
544
|
-
|
545
|
-
Else
|
546
|
-
|
547
|
-
'空白でないなら
|
548
|
-
|
549
|
-
If Len(v(ix)) > 0 Then
|
550
|
-
|
551
|
-
'スペース文字で文字列を分割し最初の値を再設定
|
552
|
-
|
553
|
-
v(ix) = Split(v(ix), " ")(0)
|
554
|
-
|
555
|
-
End If
|
556
|
-
|
557
|
-
End If
|
558
|
-
|
559
|
-
Next
|
560
|
-
|
561
|
-
'シート上へ転記
|
562
|
-
|
563
|
-
With rngTo.Resize(, rngFrom.Columns.Count)
|
564
|
-
|
565
|
-
.Value = v
|
566
|
-
|
567
|
-
'選択範囲内で中央に配置の設定
|
568
|
-
|
569
|
-
.HorizontalAlignment = xlCenterAcrossSelection
|
570
|
-
|
571
|
-
End With
|
572
|
-
|
573
|
-
End Sub
|
574
|
-
|
575
|
-
|
576
|
-
|
577
|
-
'******************************
|
578
|
-
|
579
|
-
'表側の作成
|
580
|
-
|
581
|
-
'***********************
|
582
|
-
|
583
|
-
Private Sub Set表側(ByRef rngFrom As Range, ByRef rngTo As Range)
|
584
|
-
|
585
|
-
rngTo.Resize(rngFrom.Rows.Count - 1).Value = rngFrom.Offset(1).Value
|
586
|
-
|
587
|
-
End Sub
|
588
|
-
|
589
|
-
|
590
|
-
|
591
|
-
'**********************************
|
592
|
-
|
593
|
-
'表体の作成
|
594
|
-
|
595
|
-
'第一引数 rngFrom:転記元セル範囲(Range)
|
596
|
-
|
597
|
-
'第二引数 rngTo:転記先セル範囲(Range)
|
598
|
-
|
599
|
-
'第三引数 flg:データに項目(略称)を付加するかどうかのフラグ(Boolean)
|
600
|
-
|
601
|
-
'*************************************
|
602
|
-
|
603
|
-
Private Sub Set表体(ByRef rngFrom As Range, _
|
604
|
-
|
605
|
-
ByRef rngTo As Range, _
|
606
|
-
|
607
|
-
ByVal flg As Boolean)
|
608
|
-
|
609
|
-
Dim vv As Variant
|
610
|
-
|
611
|
-
Dim v As Variant
|
612
|
-
|
613
|
-
Dim ixH As Long
|
614
|
-
|
615
|
-
Dim ixV As Long
|
616
|
-
|
617
|
-
|
618
|
-
|
619
|
-
'値を2次元配列変数で取得
|
620
|
-
|
621
|
-
vv = rngFrom.Value
|
622
|
-
|
623
|
-
'略称の付加
|
624
|
-
|
625
|
-
If flg Then
|
626
|
-
|
627
|
-
'略称の元を一次配列で取得
|
628
|
-
|
629
|
-
With WorksheetFunction
|
630
|
-
|
631
|
-
v = .Transpose(.Transpose(rngFrom.Rows(0).Cells))
|
632
|
-
|
633
|
-
End With
|
634
|
-
|
635
|
-
'それぞれの値を巡回し、値に略称をくっつけていく
|
636
|
-
|
637
|
-
For ixH = LBound(vv, 1) To UBound(vv, 1)
|
638
|
-
|
639
|
-
For ixV = LBound(vv, 2) To UBound(vv, 2)
|
640
|
-
|
641
|
-
If IsEmpty(vv(ixH, ixV)) = False Then
|
642
|
-
|
643
|
-
vv(ixH, ixV) = Left(v(ixV), 1) & vv(ixH, ixV)
|
644
|
-
|
645
|
-
End If
|
646
|
-
|
647
|
-
Next
|
648
|
-
|
649
|
-
Next
|
650
|
-
|
651
|
-
End If
|
652
|
-
|
653
|
-
'転記先に転記
|
654
|
-
|
655
|
-
rngTo.Resize(rngFrom.Rows.Count, rngFrom.Columns.Count).Value = vv
|
656
|
-
|
657
|
-
End Sub
|
658
|
-
|
659
|
-
|
660
|
-
|
661
|
-
'****************<プログラム終わり>***************************
|
662
|
-
|
663
|
-
```
|
664
|
-
|
665
|
-
時間がありそうなのでコメントを入れてみました。
|
666
|
-
|
667
|
-
|
668
|
-
|
669
|
-
他人が書いたコードは解読するのに苦労するとは思いますが、
|
670
|
-
|
671
|
-
参考になれば。
|
672
|
-
|
673
|
-
|
674
|
-
|
675
|
-
参考サイト>>
|
676
|
-
|
677
|
-
[
|
533
|
+
[売上集計しているExcelの動作を軽くしたい](https://teratail.com/questions/236682)
|
678
|
-
|
679
|
-
|
534
|
+
|
680
|
-
|
681
|
-
|
682
|
-
|
683
|
-
|
535
|
+
|
684
|
-
|
685
|
-
|
536
|
+
|
686
|
-
|
687
|
-
|
537
|
+
↑こちらもピボットテーブルを使った方法を提案しました。参考になれば。
|
4
追記
test
CHANGED
@@ -28,142 +28,106 @@
|
|
28
28
|
|
29
29
|
---
|
30
30
|
|
31
|
-
|
31
|
+
②について
|
32
|
+
|
32
|
-
|
33
|
+
上に書きましたが、自作するよりエクセル君が出来ることは、
|
34
|
+
|
35
|
+
エクセル君に任せた方が処理が速い場合が多いです。
|
36
|
+
|
37
|
+
意図が通じて無いようですが、
|
38
|
+
|
39
|
+
事前にピボットテーブルを設定したファイルを配布するのですから、
|
40
|
+
|
41
|
+
ユーザーがピボットテーブルを触ることはありません。
|
42
|
+
|
43
|
+
マクロで自動でやってもらうよう指示するだけです。
|
44
|
+
|
45
|
+
|
46
|
+
|
47
|
+
③について、
|
48
|
+
|
49
|
+
>1行空けて
|
50
|
+
|
51
|
+
with worksheets("?").usedrange
|
52
|
+
|
53
|
+
.offset(.rows.count+2).cells(1)
|
54
|
+
|
55
|
+
end with
|
56
|
+
|
57
|
+
|
58
|
+
|
33
|
-
|
59
|
+
↑が貼付先のセルになると思います。
|
60
|
+
|
61
|
+
|
62
|
+
|
34
|
-
|
63
|
+
>列幅を揃える
|
64
|
+
|
65
|
+
エクセルにまかせていいなら、
|
66
|
+
|
67
|
+
|
68
|
+
|
69
|
+
worksheets("?").usedrange.entirecolumn.autofit
|
70
|
+
|
71
|
+
|
72
|
+
|
73
|
+
各列に既定の幅を設定するなら、
|
74
|
+
|
75
|
+
各列毎に設定してください。
|
76
|
+
|
77
|
+
コードはマクロの記録で探ることが可能だと思います。
|
78
|
+
|
79
|
+
|
80
|
+
|
81
|
+
④について
|
82
|
+
|
83
|
+
ピボットテーブルというのはまさにこういう表を作るための機能なので、
|
84
|
+
|
85
|
+
それを捨てて自分で一から、同じ機能を作るのはナンセンスかなと思いますが、
|
86
|
+
|
87
|
+
関数でも作成可能です。
|
88
|
+
|
89
|
+
表の縦横の項目名を参照して、合計するなら、
|
90
|
+
|
91
|
+
Sumifs関数が使えます。
|
92
|
+
|
93
|
+
[SUMIFS関数で複数の条件を指定して数値を合計す](https://dekiru.net/article/4365/)る
|
94
|
+
|
95
|
+
|
96
|
+
|
97
|
+
当然マクロで一から作ることも可能ですが、
|
98
|
+
|
99
|
+
処理速度はデータ数が多くなるほど処理が重くなると思います。
|
100
|
+
|
101
|
+
が、全然できないよりは出来た方がいいとおもいます。
|
102
|
+
|
103
|
+
が、テーマがたくさんあると、見る人が何に困っているかわかりずらいので、
|
104
|
+
|
105
|
+
別途質問してはいかがでしょうか?
|
106
|
+
|
107
|
+
|
108
|
+
|
109
|
+
---
|
110
|
+
|
111
|
+
> ②について教えて頂きたいのですが様式の表のように「場所+時間」を
|
112
|
+
|
35
|
-
>
|
113
|
+
> ピポッドで表示するにはどうのようにしたらよいのでしょうか?
|
114
|
+
|
115
|
+
|
116
|
+
|
36
|
-
|
117
|
+
「場所」は列ラベルでは?
|
118
|
+
|
119
|
+
|
120
|
+
|
121
|
+
![イメージ説明](81f8be99e85bd7d6398ec48699266a65.jpeg)
|
122
|
+
|
123
|
+
|
124
|
+
|
125
|
+
---
|
126
|
+
|
37
|
-
>
|
127
|
+
> 表の様式は管理上変更できません。
|
38
128
|
|
39
129
|
>
|
40
130
|
|
41
|
-
>
|
42
|
-
|
43
|
-
> 実行時エラー1004
|
44
|
-
|
45
|
-
> アプリケーション定義またはオブジェクト定義のエラーです。
|
46
|
-
|
47
|
-
>
|
48
|
-
|
49
|
-
> .Add Type:=xlValidateList, _
|
50
|
-
|
51
|
-
> AlertStyle:=xlValidAlertStop, _
|
52
|
-
|
53
|
-
> Operator:=xlBetween, _
|
54
|
-
|
55
|
-
> Formula1:="=名前リスト"
|
56
|
-
|
57
|
-
|
58
|
-
|
59
|
-
名前リストという名前の定義を消したのでは?
|
60
|
-
|
61
|
-
オブジェクト定義というのは、
|
62
|
-
|
63
|
-
今回の場合、指定されたセル範囲(=Rangeオブジェクトと呼ぶ)が存在しない場合によく出ます。
|
64
|
-
|
65
|
-
|
66
|
-
|
67
|
-
②について
|
68
|
-
|
69
|
-
上に書きましたが、自作するよりエクセル君が出来ることは、
|
70
|
-
|
71
|
-
エクセル君に任せた方が処理が速い場合が多いです。
|
72
|
-
|
73
|
-
意図が通じて無いようですが、
|
74
|
-
|
75
|
-
事前にピボットテーブルを設定したファイルを配布するのですから、
|
76
|
-
|
77
|
-
ユーザーがピボットテーブルを触ることはありません。
|
78
|
-
|
79
|
-
マクロで自動でやってもらうよう指示するだけです。
|
80
|
-
|
81
|
-
|
82
|
-
|
83
|
-
③について、
|
84
|
-
|
85
|
-
>1行空けて
|
86
|
-
|
87
|
-
with worksheets("?").usedrange
|
88
|
-
|
89
|
-
.offset(.rows.count+2).cells(1)
|
90
|
-
|
91
|
-
end with
|
92
|
-
|
93
|
-
|
94
|
-
|
95
|
-
↑が貼付先のセルになると思います。
|
96
|
-
|
97
|
-
|
98
|
-
|
99
|
-
>列幅を揃える
|
100
|
-
|
101
|
-
エクセルにまかせていいなら、
|
102
|
-
|
103
|
-
|
104
|
-
|
105
|
-
worksheets("?").usedrange.entirecolumn.autofit
|
106
|
-
|
107
|
-
|
108
|
-
|
109
|
-
各列に既定の幅を設定するなら、
|
110
|
-
|
111
|
-
各列毎に設定してください。
|
112
|
-
|
113
|
-
コードはマクロの記録で探ることが可能だと思います。
|
114
|
-
|
115
|
-
|
116
|
-
|
117
|
-
④について
|
118
|
-
|
119
|
-
ピボットテーブルというのはまさにこういう表を作るための機能なので、
|
120
|
-
|
121
|
-
それを捨てて自分で一から、同じ機能を作るのはナンセンスかなと思いますが、
|
122
|
-
|
123
|
-
関数でも作成可能です。
|
124
|
-
|
125
|
-
表の縦横の項目名を参照して、合計するなら、
|
126
|
-
|
127
|
-
Sumifs関数が使えます。
|
128
|
-
|
129
|
-
[SUMIFS関数で複数の条件を指定して数値を合計す](https://dekiru.net/article/4365/)る
|
130
|
-
|
131
|
-
|
132
|
-
|
133
|
-
当然マクロで一から作ることも可能ですが、
|
134
|
-
|
135
|
-
処理速度はデータ数が多くなるほど処理が重くなると思います。
|
136
|
-
|
137
|
-
が、全然できないよりは出来た方がいいとおもいます。
|
138
|
-
|
139
|
-
が、テーマがたくさんあると、見る人が何に困っているかわかりずらいので、
|
140
|
-
|
141
|
-
別途質問してはいかがでしょうか?
|
142
|
-
|
143
|
-
|
144
|
-
|
145
|
-
---
|
146
|
-
|
147
|
-
> ②について教えて頂きたいのですが様式の表のように「場所+時間」を
|
148
|
-
|
149
|
-
> ピポッドで表示するにはどうのようにしたらよいのでしょうか?
|
150
|
-
|
151
|
-
|
152
|
-
|
153
|
-
「場所」は列ラベルでは?
|
154
|
-
|
155
|
-
|
156
|
-
|
157
|
-
![イメージ説明](81f8be99e85bd7d6398ec48699266a65.jpeg)
|
158
|
-
|
159
|
-
|
160
|
-
|
161
|
-
---
|
162
|
-
|
163
|
-
> 表の様式は管理上変更できません。
|
164
|
-
|
165
|
-
>
|
166
|
-
|
167
131
|
> 表の様式をピポッドで作成する方法がありましたら教えて下さい。
|
168
132
|
|
169
133
|
|
@@ -284,10 +248,28 @@
|
|
284
248
|
|
285
249
|
```ExcelVBA
|
286
250
|
|
251
|
+
'***********************
|
252
|
+
|
253
|
+
'ピボットテーブルを使った自分好みのクロス集計表を作成するサンプル
|
254
|
+
|
255
|
+
'作成者:mattuwan
|
256
|
+
|
257
|
+
'※著作権は放棄しますです。自己責任で使用・改変してください。
|
258
|
+
|
259
|
+
'※エラー回避処理は万全ではないかもしれません。(バグがあるかも?)
|
260
|
+
|
261
|
+
'*************************
|
262
|
+
|
287
263
|
Option Explicit
|
288
264
|
|
289
265
|
|
290
266
|
|
267
|
+
'********************************
|
268
|
+
|
269
|
+
'集計表シートにクロス集計表を2つ作成
|
270
|
+
|
271
|
+
'***********************************
|
272
|
+
|
291
273
|
Sub Main()
|
292
274
|
|
293
275
|
Dim rngWritingPosition As Range
|
@@ -312,38 +294,76 @@
|
|
312
294
|
|
313
295
|
|
314
296
|
|
297
|
+
'*************************************
|
298
|
+
|
299
|
+
'表側及び表頭の項目を指定して集計し集計表の指定したセルに結果を挿入
|
300
|
+
|
301
|
+
'第一引数 strSideItem:表側に使う項目(String)
|
302
|
+
|
303
|
+
'第二引数 strTopItem:表頭に使う項目(複数指定する場合はカンマ区切りで指定)(String)
|
304
|
+
|
305
|
+
'第三引数 rngTopLeft:表を作成するセル(左上)の位置を指定(Range)
|
306
|
+
|
307
|
+
'第四引数 flg:表を作成するときにシートの初期化を行うか否かのフラグ(boolean)
|
308
|
+
|
309
|
+
'返り値:作成した表のセル範囲
|
310
|
+
|
311
|
+
'***********************************:
|
312
|
+
|
315
313
|
Private Function Get表作成(ByVal strSideItem As String, _
|
316
314
|
|
317
315
|
ByVal strTopItem As String, _
|
318
316
|
|
319
317
|
ByRef rngTopLeft As Range, _
|
320
318
|
|
321
|
-
Optional flg As Boolean = True) As Range
|
319
|
+
Optional ByVal flg As Boolean = True) As Range
|
322
320
|
|
323
321
|
Dim pvtTable As PivotTable
|
324
322
|
|
325
323
|
|
326
324
|
|
325
|
+
'シートの初期化
|
326
|
+
|
327
327
|
If flg Then
|
328
328
|
|
329
329
|
rngTopLeft.Worksheet.UsedRange.Clear
|
330
330
|
|
331
331
|
End If
|
332
332
|
|
333
|
+
|
334
|
+
|
333
|
-
|
335
|
+
'ピボットテーブルで集計
|
334
336
|
|
335
337
|
Set pvtTable = GetPvt集計(strSideItem, strTopItem)
|
336
338
|
|
339
|
+
|
340
|
+
|
341
|
+
'集計結果を編集して集計用シートに集計表を作成
|
342
|
+
|
337
343
|
Set集計表シートへ転記 rngTopLeft, pvtTable, flg
|
338
344
|
|
339
345
|
|
340
346
|
|
347
|
+
'返り値のセット
|
348
|
+
|
341
349
|
Set Get表作成 = rngTopLeft.CurrentRegion
|
342
350
|
|
343
351
|
End Function
|
344
352
|
|
345
353
|
|
346
354
|
|
355
|
+
'*********************************
|
356
|
+
|
357
|
+
'ピボットテーブルで集計
|
358
|
+
|
359
|
+
'第一引数 strSideItem:表側の項目(String)
|
360
|
+
|
361
|
+
'第二引数 strTopItem:表頭の項目(string)
|
362
|
+
|
363
|
+
'返り値:設定したピボットテーブル
|
364
|
+
|
365
|
+
'*****************************************
|
366
|
+
|
347
367
|
Private Function GetPvt集計(ByVal strSideItem As String, _
|
348
368
|
|
349
369
|
ByVal strTopItem As String) As PivotTable
|
@@ -364,6 +384,8 @@
|
|
364
384
|
|
365
385
|
|
366
386
|
|
387
|
+
'セル範囲、ピボットテーブルの取得
|
388
|
+
|
367
389
|
Set wbk = ThisWorkbook
|
368
390
|
|
369
391
|
Set rngSourceData = wbk.Worksheets("日報").Range("A1").CurrentRegion
|
@@ -376,10 +398,16 @@
|
|
376
398
|
|
377
399
|
|
378
400
|
|
401
|
+
'ピボットテーブルでの集計
|
402
|
+
|
379
403
|
With pvtTable
|
380
404
|
|
405
|
+
'初期化
|
406
|
+
|
381
407
|
.ClearTable
|
382
408
|
|
409
|
+
'項目の配置
|
410
|
+
|
383
411
|
.PivotFields(strSideItem).Orientation = xlRowField
|
384
412
|
|
385
413
|
For Each v In Split(strTopItem, ",")
|
@@ -390,6 +418,8 @@
|
|
390
418
|
|
391
419
|
.AddDataField .PivotFields("執務時間")
|
392
420
|
|
421
|
+
'小計行の非表示化
|
422
|
+
|
393
423
|
For Each f In .PivotFields
|
394
424
|
|
395
425
|
f.Subtotals(1) = False
|
@@ -398,12 +428,18 @@
|
|
398
428
|
|
399
429
|
End With
|
400
430
|
|
431
|
+
|
432
|
+
|
433
|
+
'返り値のセット
|
434
|
+
|
401
435
|
Set GetPvt集計 = pvtTable
|
402
436
|
|
403
437
|
Exit Function
|
404
438
|
|
405
439
|
|
406
440
|
|
441
|
+
'エラー回避処理(ピボットテーブルがシート上に未作成の場合は新規に作成)
|
442
|
+
|
407
443
|
ErrHandler:
|
408
444
|
|
409
445
|
Set pvtCache = wbk.PivotCaches.Create( _
|
@@ -422,28 +458,60 @@
|
|
422
458
|
|
423
459
|
|
424
460
|
|
461
|
+
'**************************************
|
462
|
+
|
463
|
+
'ピボットテーブルでの集計結果を編集して集計表シートに集計表を作成
|
464
|
+
|
465
|
+
'第一引数 rngCopyTo:作成するセルの位置(左上)(Range)
|
466
|
+
|
467
|
+
'第二引数 pvtCopyFrom:集計表の元となるピボットテーブル(PivotTable)
|
468
|
+
|
469
|
+
'第三引数 flg:シートを初期化したかどうかのフラグ、初期化されない場合は表頭を標記しない(Boolean)
|
470
|
+
|
471
|
+
'***************************************
|
472
|
+
|
425
473
|
Private Sub Set集計表シートへ転記(ByRef rngCopyTo As Range, _
|
426
474
|
|
427
475
|
ByRef pvtCopyFrom As PivotTable, _
|
428
476
|
|
429
477
|
ByVal flg As Boolean)
|
430
478
|
|
479
|
+
'表頭の作成
|
480
|
+
|
431
481
|
If flg Then
|
432
482
|
|
433
483
|
Set表頭 pvtCopyFrom.TableRange1.Rows(2), rngCopyTo
|
434
484
|
|
435
485
|
End If
|
436
486
|
|
487
|
+
'表側の作成
|
488
|
+
|
437
489
|
Set表側 pvtCopyFrom.RowRange, rngCopyTo.Offset(1)
|
438
490
|
|
491
|
+
'表体の作成
|
492
|
+
|
439
493
|
Set表体 pvtCopyFrom.DataBodyRange, rngCopyTo.Offset(1, 1), flg
|
440
494
|
|
495
|
+
|
496
|
+
|
497
|
+
'列幅をオートフィット
|
498
|
+
|
441
499
|
rngCopyTo.CurrentRegion.EntireColumn.AutoFit
|
442
500
|
|
443
501
|
End Sub
|
444
502
|
|
445
503
|
|
446
504
|
|
505
|
+
'**************************************
|
506
|
+
|
507
|
+
'表頭の作成
|
508
|
+
|
509
|
+
'第一引数 rngFrom:転記元のセル範囲(Range)
|
510
|
+
|
511
|
+
'第二引数 rngTo:転記先のセル範囲(Range)
|
512
|
+
|
513
|
+
'******************************************
|
514
|
+
|
447
515
|
Private Sub Set表頭(ByRef rngFrom As Range, ByRef rngTo As Range)
|
448
516
|
|
449
517
|
Dim v As Variant
|
@@ -452,12 +520,22 @@
|
|
452
520
|
|
453
521
|
|
454
522
|
|
523
|
+
'元のセル範囲の値を一次配列で取得
|
524
|
+
|
525
|
+
'(ワークシート上の関数はセル範囲を与える仕様だが、
|
526
|
+
|
527
|
+
'配列も受け取れる関数があるので値(Value)を与えてもよい。)
|
528
|
+
|
455
529
|
With WorksheetFunction
|
456
530
|
|
457
531
|
v = .Transpose(.Transpose(rngFrom.Cells))
|
458
532
|
|
459
533
|
End With
|
460
534
|
|
535
|
+
|
536
|
+
|
537
|
+
'それぞれの値の加工
|
538
|
+
|
461
539
|
For ix = LBound(v) To UBound(v)
|
462
540
|
|
463
541
|
If ix = 1 Then
|
@@ -466,8 +544,12 @@
|
|
466
544
|
|
467
545
|
Else
|
468
546
|
|
547
|
+
'空白でないなら
|
548
|
+
|
469
549
|
If Len(v(ix)) > 0 Then
|
470
550
|
|
551
|
+
'スペース文字で文字列を分割し最初の値を再設定
|
552
|
+
|
471
553
|
v(ix) = Split(v(ix), " ")(0)
|
472
554
|
|
473
555
|
End If
|
@@ -476,10 +558,14 @@
|
|
476
558
|
|
477
559
|
Next
|
478
560
|
|
561
|
+
'シート上へ転記
|
562
|
+
|
479
563
|
With rngTo.Resize(, rngFrom.Columns.Count)
|
480
564
|
|
481
565
|
.Value = v
|
482
566
|
|
567
|
+
'選択範囲内で中央に配置の設定
|
568
|
+
|
483
569
|
.HorizontalAlignment = xlCenterAcrossSelection
|
484
570
|
|
485
571
|
End With
|
@@ -488,6 +574,12 @@
|
|
488
574
|
|
489
575
|
|
490
576
|
|
577
|
+
'******************************
|
578
|
+
|
579
|
+
'表側の作成
|
580
|
+
|
581
|
+
'***********************
|
582
|
+
|
491
583
|
Private Sub Set表側(ByRef rngFrom As Range, ByRef rngTo As Range)
|
492
584
|
|
493
585
|
rngTo.Resize(rngFrom.Rows.Count - 1).Value = rngFrom.Offset(1).Value
|
@@ -496,6 +588,18 @@
|
|
496
588
|
|
497
589
|
|
498
590
|
|
591
|
+
'**********************************
|
592
|
+
|
593
|
+
'表体の作成
|
594
|
+
|
595
|
+
'第一引数 rngFrom:転記元セル範囲(Range)
|
596
|
+
|
597
|
+
'第二引数 rngTo:転記先セル範囲(Range)
|
598
|
+
|
599
|
+
'第三引数 flg:データに項目(略称)を付加するかどうかのフラグ(Boolean)
|
600
|
+
|
601
|
+
'*************************************
|
602
|
+
|
499
603
|
Private Sub Set表体(ByRef rngFrom As Range, _
|
500
604
|
|
501
605
|
ByRef rngTo As Range, _
|
@@ -512,17 +616,23 @@
|
|
512
616
|
|
513
617
|
|
514
618
|
|
619
|
+
'値を2次元配列変数で取得
|
620
|
+
|
515
621
|
vv = rngFrom.Value
|
516
622
|
|
623
|
+
'略称の付加
|
624
|
+
|
517
625
|
If flg Then
|
518
626
|
|
627
|
+
'略称の元を一次配列で取得
|
628
|
+
|
519
629
|
With WorksheetFunction
|
520
630
|
|
521
|
-
v = .Transpose(.Transpose(rngFrom.Rows(0)))
|
631
|
+
v = .Transpose(.Transpose(rngFrom.Rows(0).Cells))
|
522
632
|
|
523
633
|
End With
|
524
634
|
|
525
|
-
|
635
|
+
'それぞれの値を巡回し、値に略称をくっつけていく
|
526
636
|
|
527
637
|
For ixH = LBound(vv, 1) To UBound(vv, 1)
|
528
638
|
|
@@ -540,28 +650,38 @@
|
|
540
650
|
|
541
651
|
End If
|
542
652
|
|
653
|
+
'転記先に転記
|
654
|
+
|
543
655
|
rngTo.Resize(rngFrom.Rows.Count, rngFrom.Columns.Count).Value = vv
|
544
656
|
|
545
657
|
End Sub
|
546
658
|
|
659
|
+
|
660
|
+
|
661
|
+
'****************<プログラム終わり>***************************
|
662
|
+
|
547
663
|
```
|
548
664
|
|
665
|
+
時間がありそうなのでコメントを入れてみました。
|
666
|
+
|
667
|
+
|
668
|
+
|
549
669
|
他人が書いたコードは解読するのに苦労するとは思いますが、
|
550
670
|
|
551
671
|
参考になれば。
|
552
672
|
|
673
|
+
|
674
|
+
|
675
|
+
参考サイト>>
|
676
|
+
|
553
|
-
|
677
|
+
[構造化プログラミングに挑戦しよう!](http://home.att.ne.jp/zeta/gen/excel/c03p06.htm)
|
678
|
+
|
554
|
-
|
679
|
+
[仕様要件からコードの組み立てを考える。](http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_160.html)
|
680
|
+
|
681
|
+
|
682
|
+
|
555
|
-
|
683
|
+
他にもいいサイトがある気がします。
|
556
|
-
|
557
|
-
|
684
|
+
|
558
|
-
|
559
|
-
解読してみてわからないところがあれば、
|
560
|
-
|
561
|
-
|
685
|
+
探してみてください。
|
562
|
-
|
563
|
-
|
686
|
+
|
564
|
-
|
565
|
-
全部解説してたら、どんだけ時間が掛かるかわからないし、
|
566
|
-
|
567
|
-
|
687
|
+
※文字数制限に引っかかったため、一部削除しました。
|
3
追記
test
CHANGED
@@ -155,3 +155,413 @@
|
|
155
155
|
|
156
156
|
|
157
157
|
![イメージ説明](81f8be99e85bd7d6398ec48699266a65.jpeg)
|
158
|
+
|
159
|
+
|
160
|
+
|
161
|
+
---
|
162
|
+
|
163
|
+
> 表の様式は管理上変更できません。
|
164
|
+
|
165
|
+
>
|
166
|
+
|
167
|
+
> 表の様式をピポッドで作成する方法がありましたら教えて下さい。
|
168
|
+
|
169
|
+
|
170
|
+
|
171
|
+
う~ん。。。
|
172
|
+
|
173
|
+
ピボットテーブルで集計し、それをご自分の好きなように表示するよう加工することになります。
|
174
|
+
|
175
|
+
|
176
|
+
|
177
|
+
例えば、
|
178
|
+
|
179
|
+
自ブック(マクロを仕込むブック)に、
|
180
|
+
|
181
|
+
日報
|
182
|
+
|
183
|
+
集計表
|
184
|
+
|
185
|
+
作業用
|
186
|
+
|
187
|
+
の3つのシートがあるとします。
|
188
|
+
|
189
|
+
そして日報シートに、
|
190
|
+
|
191
|
+
|
192
|
+
|
193
|
+
```ここに言語を入力
|
194
|
+
|
195
|
+
日付 場所 氏名 執務時間
|
196
|
+
|
197
|
+
|
198
|
+
|
199
|
+
2020.7.1 事務所 織田 信長 7
|
200
|
+
|
201
|
+
|
202
|
+
|
203
|
+
2020.7.5 事務所 明智 光秀 2.5
|
204
|
+
|
205
|
+
|
206
|
+
|
207
|
+
2020.7.9 本社 織田 信長 3.5
|
208
|
+
|
209
|
+
|
210
|
+
|
211
|
+
2020.7.13 本社 千 利休 1
|
212
|
+
|
213
|
+
|
214
|
+
|
215
|
+
2020.7.17 本社 徳川 家康 5
|
216
|
+
|
217
|
+
|
218
|
+
|
219
|
+
2020.7.21 子会社 武田 信玄 7
|
220
|
+
|
221
|
+
|
222
|
+
|
223
|
+
2020.7.25 支店・営業所 織田 信長 2.5
|
224
|
+
|
225
|
+
|
226
|
+
|
227
|
+
2020.7.29 事務所 明智 光秀 3.5
|
228
|
+
|
229
|
+
|
230
|
+
|
231
|
+
2020.8.2 事務所 織田 信長 1
|
232
|
+
|
233
|
+
|
234
|
+
|
235
|
+
2020.8.6 事務所 千 利休 5
|
236
|
+
|
237
|
+
|
238
|
+
|
239
|
+
2020.8.10 本社 徳川 家康 7
|
240
|
+
|
241
|
+
|
242
|
+
|
243
|
+
2020.8.14 本社 武田 信玄 2.5
|
244
|
+
|
245
|
+
|
246
|
+
|
247
|
+
2020.8.18 本社 織田 信長 3.5
|
248
|
+
|
249
|
+
|
250
|
+
|
251
|
+
2020.8.22 子会社 明智 光秀 1
|
252
|
+
|
253
|
+
|
254
|
+
|
255
|
+
2020.8.26 支店・営業所 織田 信長 5
|
256
|
+
|
257
|
+
|
258
|
+
|
259
|
+
2020.8.30 本社 千 利休 7
|
260
|
+
|
261
|
+
|
262
|
+
|
263
|
+
2020.9.3 子会社 徳川 家康 2.5
|
264
|
+
|
265
|
+
|
266
|
+
|
267
|
+
2020.9.7 支店・営業所 武田 信玄 3.5
|
268
|
+
|
269
|
+
```
|
270
|
+
|
271
|
+
|
272
|
+
|
273
|
+
というようなデータがあるとして、
|
274
|
+
|
275
|
+
|
276
|
+
|
277
|
+
以下のようなコードで、
|
278
|
+
|
279
|
+
自分好みの表(そちらの希望に沿ってはいません。)を作ることが可能です。
|
280
|
+
|
281
|
+
あとの表示の順番や、列の具合、抽出したい月とかはそちらの希望するよう加工編集してください。
|
282
|
+
|
283
|
+
|
284
|
+
|
285
|
+
```ExcelVBA
|
286
|
+
|
287
|
+
Option Explicit
|
288
|
+
|
289
|
+
|
290
|
+
|
291
|
+
Sub Main()
|
292
|
+
|
293
|
+
Dim rngWritingPosition As Range
|
294
|
+
|
295
|
+
|
296
|
+
|
297
|
+
Set rngWritingPosition = Worksheets("集計表").Range("A1")
|
298
|
+
|
299
|
+
Get表作成 "日付", "氏名,場所", rngWritingPosition
|
300
|
+
|
301
|
+
|
302
|
+
|
303
|
+
With rngWritingPosition.CurrentRegion
|
304
|
+
|
305
|
+
Set rngWritingPosition = .Cells(1).Offset(.Rows.Count)
|
306
|
+
|
307
|
+
End With
|
308
|
+
|
309
|
+
Get表作成 "場所", "氏名", rngWritingPosition, False
|
310
|
+
|
311
|
+
End Sub
|
312
|
+
|
313
|
+
|
314
|
+
|
315
|
+
Private Function Get表作成(ByVal strSideItem As String, _
|
316
|
+
|
317
|
+
ByVal strTopItem As String, _
|
318
|
+
|
319
|
+
ByRef rngTopLeft As Range, _
|
320
|
+
|
321
|
+
Optional flg As Boolean = True) As Range
|
322
|
+
|
323
|
+
Dim pvtTable As PivotTable
|
324
|
+
|
325
|
+
|
326
|
+
|
327
|
+
If flg Then
|
328
|
+
|
329
|
+
rngTopLeft.Worksheet.UsedRange.Clear
|
330
|
+
|
331
|
+
End If
|
332
|
+
|
333
|
+
|
334
|
+
|
335
|
+
Set pvtTable = GetPvt集計(strSideItem, strTopItem)
|
336
|
+
|
337
|
+
Set集計表シートへ転記 rngTopLeft, pvtTable, flg
|
338
|
+
|
339
|
+
|
340
|
+
|
341
|
+
Set Get表作成 = rngTopLeft.CurrentRegion
|
342
|
+
|
343
|
+
End Function
|
344
|
+
|
345
|
+
|
346
|
+
|
347
|
+
Private Function GetPvt集計(ByVal strSideItem As String, _
|
348
|
+
|
349
|
+
ByVal strTopItem As String) As PivotTable
|
350
|
+
|
351
|
+
Dim pvtCache As PivotCache
|
352
|
+
|
353
|
+
Dim pvtTable As PivotTable
|
354
|
+
|
355
|
+
Dim f As PivotField
|
356
|
+
|
357
|
+
Dim rngSourceData As Range
|
358
|
+
|
359
|
+
Dim rngWorkCellRange As Range
|
360
|
+
|
361
|
+
Dim v As Variant
|
362
|
+
|
363
|
+
Dim wbk As Workbook
|
364
|
+
|
365
|
+
|
366
|
+
|
367
|
+
Set wbk = ThisWorkbook
|
368
|
+
|
369
|
+
Set rngSourceData = wbk.Worksheets("日報").Range("A1").CurrentRegion
|
370
|
+
|
371
|
+
On Error GoTo ErrHandler
|
372
|
+
|
373
|
+
Set pvtTable = wbk.Worksheets("作業用").PivotTables(1)
|
374
|
+
|
375
|
+
On Error GoTo 0
|
376
|
+
|
377
|
+
|
378
|
+
|
379
|
+
With pvtTable
|
380
|
+
|
381
|
+
.ClearTable
|
382
|
+
|
383
|
+
.PivotFields(strSideItem).Orientation = xlRowField
|
384
|
+
|
385
|
+
For Each v In Split(strTopItem, ",")
|
386
|
+
|
387
|
+
.PivotFields(v).Orientation = xlColumnField
|
388
|
+
|
389
|
+
Next
|
390
|
+
|
391
|
+
.AddDataField .PivotFields("執務時間")
|
392
|
+
|
393
|
+
For Each f In .PivotFields
|
394
|
+
|
395
|
+
f.Subtotals(1) = False
|
396
|
+
|
397
|
+
Next
|
398
|
+
|
399
|
+
End With
|
400
|
+
|
401
|
+
Set GetPvt集計 = pvtTable
|
402
|
+
|
403
|
+
Exit Function
|
404
|
+
|
405
|
+
|
406
|
+
|
407
|
+
ErrHandler:
|
408
|
+
|
409
|
+
Set pvtCache = wbk.PivotCaches.Create( _
|
410
|
+
|
411
|
+
SourceType:=xlDatabase, _
|
412
|
+
|
413
|
+
SourceData:=rngSourceData)
|
414
|
+
|
415
|
+
Set rngWorkCellRange = wbk.Worksheets("作業用").Range("A1")
|
416
|
+
|
417
|
+
Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=rngWorkCellRange)
|
418
|
+
|
419
|
+
Resume Next
|
420
|
+
|
421
|
+
End Function
|
422
|
+
|
423
|
+
|
424
|
+
|
425
|
+
Private Sub Set集計表シートへ転記(ByRef rngCopyTo As Range, _
|
426
|
+
|
427
|
+
ByRef pvtCopyFrom As PivotTable, _
|
428
|
+
|
429
|
+
ByVal flg As Boolean)
|
430
|
+
|
431
|
+
If flg Then
|
432
|
+
|
433
|
+
Set表頭 pvtCopyFrom.TableRange1.Rows(2), rngCopyTo
|
434
|
+
|
435
|
+
End If
|
436
|
+
|
437
|
+
Set表側 pvtCopyFrom.RowRange, rngCopyTo.Offset(1)
|
438
|
+
|
439
|
+
Set表体 pvtCopyFrom.DataBodyRange, rngCopyTo.Offset(1, 1), flg
|
440
|
+
|
441
|
+
rngCopyTo.CurrentRegion.EntireColumn.AutoFit
|
442
|
+
|
443
|
+
End Sub
|
444
|
+
|
445
|
+
|
446
|
+
|
447
|
+
Private Sub Set表頭(ByRef rngFrom As Range, ByRef rngTo As Range)
|
448
|
+
|
449
|
+
Dim v As Variant
|
450
|
+
|
451
|
+
Dim ix As Long
|
452
|
+
|
453
|
+
|
454
|
+
|
455
|
+
With WorksheetFunction
|
456
|
+
|
457
|
+
v = .Transpose(.Transpose(rngFrom.Cells))
|
458
|
+
|
459
|
+
End With
|
460
|
+
|
461
|
+
For ix = LBound(v) To UBound(v)
|
462
|
+
|
463
|
+
If ix = 1 Then
|
464
|
+
|
465
|
+
v(ix) = "日付"
|
466
|
+
|
467
|
+
Else
|
468
|
+
|
469
|
+
If Len(v(ix)) > 0 Then
|
470
|
+
|
471
|
+
v(ix) = Split(v(ix), " ")(0)
|
472
|
+
|
473
|
+
End If
|
474
|
+
|
475
|
+
End If
|
476
|
+
|
477
|
+
Next
|
478
|
+
|
479
|
+
With rngTo.Resize(, rngFrom.Columns.Count)
|
480
|
+
|
481
|
+
.Value = v
|
482
|
+
|
483
|
+
.HorizontalAlignment = xlCenterAcrossSelection
|
484
|
+
|
485
|
+
End With
|
486
|
+
|
487
|
+
End Sub
|
488
|
+
|
489
|
+
|
490
|
+
|
491
|
+
Private Sub Set表側(ByRef rngFrom As Range, ByRef rngTo As Range)
|
492
|
+
|
493
|
+
rngTo.Resize(rngFrom.Rows.Count - 1).Value = rngFrom.Offset(1).Value
|
494
|
+
|
495
|
+
End Sub
|
496
|
+
|
497
|
+
|
498
|
+
|
499
|
+
Private Sub Set表体(ByRef rngFrom As Range, _
|
500
|
+
|
501
|
+
ByRef rngTo As Range, _
|
502
|
+
|
503
|
+
ByVal flg As Boolean)
|
504
|
+
|
505
|
+
Dim vv As Variant
|
506
|
+
|
507
|
+
Dim v As Variant
|
508
|
+
|
509
|
+
Dim ixH As Long
|
510
|
+
|
511
|
+
Dim ixV As Long
|
512
|
+
|
513
|
+
|
514
|
+
|
515
|
+
vv = rngFrom.Value
|
516
|
+
|
517
|
+
If flg Then
|
518
|
+
|
519
|
+
With WorksheetFunction
|
520
|
+
|
521
|
+
v = .Transpose(.Transpose(rngFrom.Rows(0)))
|
522
|
+
|
523
|
+
End With
|
524
|
+
|
525
|
+
|
526
|
+
|
527
|
+
For ixH = LBound(vv, 1) To UBound(vv, 1)
|
528
|
+
|
529
|
+
For ixV = LBound(vv, 2) To UBound(vv, 2)
|
530
|
+
|
531
|
+
If IsEmpty(vv(ixH, ixV)) = False Then
|
532
|
+
|
533
|
+
vv(ixH, ixV) = Left(v(ixV), 1) & vv(ixH, ixV)
|
534
|
+
|
535
|
+
End If
|
536
|
+
|
537
|
+
Next
|
538
|
+
|
539
|
+
Next
|
540
|
+
|
541
|
+
End If
|
542
|
+
|
543
|
+
rngTo.Resize(rngFrom.Rows.Count, rngFrom.Columns.Count).Value = vv
|
544
|
+
|
545
|
+
End Sub
|
546
|
+
|
547
|
+
```
|
548
|
+
|
549
|
+
他人が書いたコードは解読するのに苦労するとは思いますが、
|
550
|
+
|
551
|
+
参考になれば。
|
552
|
+
|
553
|
+
ここまで一から書くのに僕の力量で、ヘルプやオブジェクトブラウザで調べながら
|
554
|
+
|
555
|
+
だいたい4時間くらいかかりました。
|
556
|
+
|
557
|
+
ぜんぜん解らないところから始めるなら2週間~数か月かかるかも知れません。
|
558
|
+
|
559
|
+
解読してみてわからないところがあれば、
|
560
|
+
|
561
|
+
も少しピンポイントで質問してください。
|
562
|
+
|
563
|
+
どこから解説していいか解らないし、
|
564
|
+
|
565
|
+
全部解説してたら、どんだけ時間が掛かるかわからないし、
|
566
|
+
|
567
|
+
入門書1冊書けるくらいかかないといけないようになるので。
|
2
追記
test
CHANGED
@@ -139,3 +139,19 @@
|
|
139
139
|
が、テーマがたくさんあると、見る人が何に困っているかわかりずらいので、
|
140
140
|
|
141
141
|
別途質問してはいかがでしょうか?
|
142
|
+
|
143
|
+
|
144
|
+
|
145
|
+
---
|
146
|
+
|
147
|
+
> ②について教えて頂きたいのですが様式の表のように「場所+時間」を
|
148
|
+
|
149
|
+
> ピポッドで表示するにはどうのようにしたらよいのでしょうか?
|
150
|
+
|
151
|
+
|
152
|
+
|
153
|
+
「場所」は列ラベルでは?
|
154
|
+
|
155
|
+
|
156
|
+
|
157
|
+
![イメージ説明](81f8be99e85bd7d6398ec48699266a65.jpeg)
|
1
追記
test
CHANGED
@@ -23,3 +23,119 @@
|
|
23
23
|
3)結果を見せるシートにコピペして好みの形に再編集
|
24
24
|
|
25
25
|
ぐらいになると思いますがどうでしょうか?
|
26
|
+
|
27
|
+
|
28
|
+
|
29
|
+
---
|
30
|
+
|
31
|
+
|
32
|
+
|
33
|
+
> ① 4)にエラーが出ます。
|
34
|
+
|
35
|
+
> 先月まではエラーはありませんでした。
|
36
|
+
|
37
|
+
> 何が原因か分かりません。
|
38
|
+
|
39
|
+
>
|
40
|
+
|
41
|
+
>
|
42
|
+
|
43
|
+
> 実行時エラー1004
|
44
|
+
|
45
|
+
> アプリケーション定義またはオブジェクト定義のエラーです。
|
46
|
+
|
47
|
+
>
|
48
|
+
|
49
|
+
> .Add Type:=xlValidateList, _
|
50
|
+
|
51
|
+
> AlertStyle:=xlValidAlertStop, _
|
52
|
+
|
53
|
+
> Operator:=xlBetween, _
|
54
|
+
|
55
|
+
> Formula1:="=名前リスト"
|
56
|
+
|
57
|
+
|
58
|
+
|
59
|
+
名前リストという名前の定義を消したのでは?
|
60
|
+
|
61
|
+
オブジェクト定義というのは、
|
62
|
+
|
63
|
+
今回の場合、指定されたセル範囲(=Rangeオブジェクトと呼ぶ)が存在しない場合によく出ます。
|
64
|
+
|
65
|
+
|
66
|
+
|
67
|
+
②について
|
68
|
+
|
69
|
+
上に書きましたが、自作するよりエクセル君が出来ることは、
|
70
|
+
|
71
|
+
エクセル君に任せた方が処理が速い場合が多いです。
|
72
|
+
|
73
|
+
意図が通じて無いようですが、
|
74
|
+
|
75
|
+
事前にピボットテーブルを設定したファイルを配布するのですから、
|
76
|
+
|
77
|
+
ユーザーがピボットテーブルを触ることはありません。
|
78
|
+
|
79
|
+
マクロで自動でやってもらうよう指示するだけです。
|
80
|
+
|
81
|
+
|
82
|
+
|
83
|
+
③について、
|
84
|
+
|
85
|
+
>1行空けて
|
86
|
+
|
87
|
+
with worksheets("?").usedrange
|
88
|
+
|
89
|
+
.offset(.rows.count+2).cells(1)
|
90
|
+
|
91
|
+
end with
|
92
|
+
|
93
|
+
|
94
|
+
|
95
|
+
↑が貼付先のセルになると思います。
|
96
|
+
|
97
|
+
|
98
|
+
|
99
|
+
>列幅を揃える
|
100
|
+
|
101
|
+
エクセルにまかせていいなら、
|
102
|
+
|
103
|
+
|
104
|
+
|
105
|
+
worksheets("?").usedrange.entirecolumn.autofit
|
106
|
+
|
107
|
+
|
108
|
+
|
109
|
+
各列に既定の幅を設定するなら、
|
110
|
+
|
111
|
+
各列毎に設定してください。
|
112
|
+
|
113
|
+
コードはマクロの記録で探ることが可能だと思います。
|
114
|
+
|
115
|
+
|
116
|
+
|
117
|
+
④について
|
118
|
+
|
119
|
+
ピボットテーブルというのはまさにこういう表を作るための機能なので、
|
120
|
+
|
121
|
+
それを捨てて自分で一から、同じ機能を作るのはナンセンスかなと思いますが、
|
122
|
+
|
123
|
+
関数でも作成可能です。
|
124
|
+
|
125
|
+
表の縦横の項目名を参照して、合計するなら、
|
126
|
+
|
127
|
+
Sumifs関数が使えます。
|
128
|
+
|
129
|
+
[SUMIFS関数で複数の条件を指定して数値を合計す](https://dekiru.net/article/4365/)る
|
130
|
+
|
131
|
+
|
132
|
+
|
133
|
+
当然マクロで一から作ることも可能ですが、
|
134
|
+
|
135
|
+
処理速度はデータ数が多くなるほど処理が重くなると思います。
|
136
|
+
|
137
|
+
が、全然できないよりは出来た方がいいとおもいます。
|
138
|
+
|
139
|
+
が、テーマがたくさんあると、見る人が何に困っているかわかりずらいので、
|
140
|
+
|
141
|
+
別途質問してはいかがでしょうか?
|