質問編集履歴
2
追記２
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -278,8 +278,6 @@
|
|
|
278
278
|
|
|
279
279
|
```
|
|
280
280
|
|
|
281
|
-
|
|
282
|
-
|
|
283
281
|
###試したこと
|
|
284
282
|
|
|
285
283
|
Criteria1の部分をもともとはセルで指定していたのですが、
|
|
@@ -299,3 +297,275 @@
|
|
|
299
297
|
追記１
|
|
300
298
|
|
|
301
299
|
あからさまにおかしい箇所が数点あったので修正しました。
|
|
300
|
+
|
|
301
|
+
追記２
|
|
302
|
+
|
|
303
|
+
ほぼ自己解決できました。
|
|
304
|
+
|
|
305
|
+
```
|
|
306
|
+
|
|
307
|
+
Option Explicit
|
|
308
|
+
|
|
309
|
+
|
|
310
|
+
|
|
311
|
+
Dim gyo As Long
|
|
312
|
+
|
|
313
|
+
Dim gyo2 As Long
|
|
314
|
+
|
|
315
|
+
Dim gyo3 As Long
|
|
316
|
+
|
|
317
|
+
Dim filecount As Long
|
|
318
|
+
|
|
319
|
+
Dim sheetcount As Long
|
|
320
|
+
|
|
321
|
+
Dim unmatch As Long
|
|
322
|
+
|
|
323
|
+
Dim erfilecount As Long
|
|
324
|
+
|
|
325
|
+
'ボタンを押したとき
|
|
326
|
+
|
|
327
|
+
Sub FolderSelect()
|
|
328
|
+
|
|
329
|
+
'ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
|
|
330
|
+
|
|
331
|
+
'ThisWorkbook.Worksheets(2).Range("B1:BE3005").ClearContents
|
|
332
|
+
|
|
333
|
+
Dim folderpass As String
|
|
334
|
+
|
|
335
|
+
With Application.FileDialog(msoFileDialogFolderPicker)
|
|
336
|
+
|
|
337
|
+
If .Show = True Then
|
|
338
|
+
|
|
339
|
+
folderpass = .SelectedItems(1)
|
|
340
|
+
|
|
341
|
+
Else
|
|
342
|
+
|
|
343
|
+
ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
|
|
344
|
+
|
|
345
|
+
Exit Sub
|
|
346
|
+
|
|
347
|
+
End If
|
|
348
|
+
|
|
349
|
+
End With
|
|
350
|
+
|
|
351
|
+
|
|
352
|
+
|
|
353
|
+
filecount = 0
|
|
354
|
+
|
|
355
|
+
sheetcount = 0
|
|
356
|
+
|
|
357
|
+
unmatch = 0
|
|
358
|
+
|
|
359
|
+
erfilecount = 0
|
|
360
|
+
|
|
361
|
+
gyo = 6
|
|
362
|
+
|
|
363
|
+
gyo2 = 2
|
|
364
|
+
|
|
365
|
+
|
|
366
|
+
|
|
367
|
+
|
|
368
|
+
|
|
369
|
+
ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"
|
|
370
|
+
|
|
371
|
+
|
|
372
|
+
|
|
373
|
+
Call FileSearch(folderpass, "*.csv")
|
|
374
|
+
|
|
375
|
+
Dim dateupdate As String
|
|
376
|
+
|
|
377
|
+
dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"
|
|
378
|
+
|
|
379
|
+
'ThisWorkbook.Worksheets(2).Range("A1").Value = dateupdate
|
|
380
|
+
|
|
381
|
+
'ThisWorkbook.Worksheets(2).Name = dateupdate '
|
|
382
|
+
|
|
383
|
+
ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
|
|
384
|
+
|
|
385
|
+
ThisWorkbook.Worksheets(2).Activate
|
|
386
|
+
|
|
387
|
+
End Sub
|
|
388
|
+
|
|
389
|
+
'ファイル検索
|
|
390
|
+
|
|
391
|
+
Sub FileSearch(Path As String, Target As String)
|
|
392
|
+
|
|
393
|
+
Dim FSO As Object, Folder As Variant, File As Variant
|
|
394
|
+
|
|
395
|
+
Set FSO = CreateObject("Scripting.FileSystemObject")
|
|
396
|
+
|
|
397
|
+
For Each Folder In FSO.GetFolder(Path).SubFolders
|
|
398
|
+
|
|
399
|
+
Call FileSearch(Folder.Path, Target)
|
|
400
|
+
|
|
401
|
+
Next Folder
|
|
402
|
+
|
|
403
|
+
For Each File In FSO.GetFolder(Path).Files
|
|
404
|
+
|
|
405
|
+
If File.Name Like Target Then
|
|
406
|
+
|
|
407
|
+
filecount = filecount + 1
|
|
408
|
+
|
|
409
|
+
ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name
|
|
410
|
+
|
|
411
|
+
ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path
|
|
412
|
+
|
|
413
|
+
Call ParCopy(File.Path)
|
|
414
|
+
|
|
415
|
+
gyo = gyo + 1
|
|
416
|
+
|
|
417
|
+
End If
|
|
418
|
+
|
|
419
|
+
ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
|
|
420
|
+
|
|
421
|
+
Next File
|
|
422
|
+
|
|
423
|
+
End Sub
|
|
424
|
+
|
|
425
|
+
''一覧出力
|
|
426
|
+
|
|
427
|
+
Sub ParCopy(Path As String)
|
|
428
|
+
|
|
429
|
+
|
|
430
|
+
|
|
431
|
+
|
|
432
|
+
|
|
433
|
+
Dim openbook As Workbook
|
|
434
|
+
|
|
435
|
+
Dim openbooksheet As Worksheet
|
|
436
|
+
|
|
437
|
+
Dim lp As Long
|
|
438
|
+
|
|
439
|
+
Dim el As Long
|
|
440
|
+
|
|
441
|
+
Dim br As String
|
|
442
|
+
|
|
443
|
+
'オ
|
|
444
|
+
|
|
445
|
+
Dim c As Range, Target As Range
|
|
446
|
+
|
|
447
|
+
Dim LastRow As Long
|
|
448
|
+
|
|
449
|
+
'縦軸(マクロ側シート数用)
|
|
450
|
+
|
|
451
|
+
lp = 2
|
|
452
|
+
|
|
453
|
+
'横軸(データ側ループ管理用)
|
|
454
|
+
|
|
455
|
+
el = 3
|
|
456
|
+
|
|
457
|
+
|
|
458
|
+
|
|
459
|
+
|
|
460
|
+
|
|
461
|
+
|
|
462
|
+
|
|
463
|
+
Application.ScreenUpdating = False
|
|
464
|
+
|
|
465
|
+
|
|
466
|
+
|
|
467
|
+
On Error GoTo myError
|
|
468
|
+
|
|
469
|
+
Set openbook = Application.Workbooks.Open(Path)
|
|
470
|
+
|
|
471
|
+
|
|
472
|
+
|
|
473
|
+
|
|
474
|
+
|
|
475
|
+
|
|
476
|
+
|
|
477
|
+
Set openbooksheet = openbook.Worksheets(1)
|
|
478
|
+
|
|
479
|
+
openbooksheet.Unprotect
|
|
480
|
+
|
|
481
|
+
|
|
482
|
+
|
|
483
|
+
|
|
484
|
+
|
|
485
|
+
Do Until lp = 28
|
|
486
|
+
|
|
487
|
+
|
|
488
|
+
|
|
489
|
+
Do Until ThisWorkbook.Worksheets(lp).Cells(2, el) = ""
|
|
490
|
+
|
|
491
|
+
|
|
492
|
+
|
|
493
|
+
br = ThisWorkbook.Worksheets(lp).Cells(2, el)
|
|
494
|
+
|
|
495
|
+
|
|
496
|
+
|
|
497
|
+
openbooksheet.Activate
|
|
498
|
+
|
|
499
|
+
|
|
500
|
+
|
|
501
|
+
Selection.AutoFilter
|
|
502
|
+
|
|
503
|
+
openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br
|
|
504
|
+
|
|
505
|
+
|
|
506
|
+
|
|
507
|
+
LastRow = 291826
|
|
508
|
+
|
|
509
|
+
|
|
510
|
+
|
|
511
|
+
openbooksheet.Range("J2:J" & LastRow).Copy ThisWorkbook.Worksheets(lp).Range(ThisWorkbook.Worksheets(lp).Cells(3, el), ThisWorkbook.Worksheets(lp).Cells(3, el))
|
|
512
|
+
|
|
513
|
+
openbooksheet.Range("A1").AutoFilter
|
|
514
|
+
|
|
515
|
+
|
|
516
|
+
|
|
517
|
+
|
|
518
|
+
|
|
519
|
+
el = el + 1
|
|
520
|
+
|
|
521
|
+
|
|
522
|
+
|
|
523
|
+
Loop
|
|
524
|
+
|
|
525
|
+
|
|
526
|
+
|
|
527
|
+
el = 3
|
|
528
|
+
|
|
529
|
+
|
|
530
|
+
|
|
531
|
+
lp = lp + 1
|
|
532
|
+
|
|
533
|
+
Loop
|
|
534
|
+
|
|
535
|
+
|
|
536
|
+
|
|
537
|
+
|
|
538
|
+
|
|
539
|
+
|
|
540
|
+
|
|
541
|
+
openbook.Close False
|
|
542
|
+
|
|
543
|
+
|
|
544
|
+
|
|
545
|
+
|
|
546
|
+
|
|
547
|
+
Application.ScreenUpdating = True
|
|
548
|
+
|
|
549
|
+
Exit Sub
|
|
550
|
+
|
|
551
|
+
myError:
|
|
552
|
+
|
|
553
|
+
MsgBox Err.Description
|
|
554
|
+
|
|
555
|
+
ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生"
|
|
556
|
+
|
|
557
|
+
erfilecount = erfilecount + 1
|
|
558
|
+
|
|
559
|
+
Application.ScreenUpdating = True
|
|
560
|
+
|
|
561
|
+
End Sub
|
|
562
|
+
|
|
563
|
+
```
|
|
564
|
+
|
|
565
|
+
データ側のシートをフォーマット側（マクロ）の各項目でフィルタをかけて
|
|
566
|
+
|
|
567
|
+
コピー、ペーストするというマクロです。
|
|
568
|
+
|
|
569
|
+
同じようなマクロを作る際の参考程度にしてください。
|
|
570
|
+
|
|
571
|
+
ただし、不要な部分も多いので要改変です。
|
1
ソースの修正
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -80,7 +80,7 @@
|
|
|
80
80
|
|
|
81
81
|
gyo2 = 2
|
|
82
82
|
|
|
83
|
-
|
|
83
|
+
|
|
84
84
|
|
|
85
85
|
|
|
86
86
|
|
|
@@ -166,7 +166,7 @@
|
|
|
166
166
|
|
|
167
167
|
'縦軸(マクロ側シート数用)
|
|
168
168
|
|
|
169
|
-
lp =
|
|
169
|
+
lp = 2
|
|
170
170
|
|
|
171
171
|
'横軸(データ側ループ管理用)
|
|
172
172
|
|
|
@@ -200,7 +200,7 @@
|
|
|
200
200
|
|
|
201
201
|
|
|
202
202
|
|
|
203
|
-
Do Until lp =
|
|
203
|
+
Do Until lp = 28
|
|
204
204
|
|
|
205
205
|
|
|
206
206
|
|
|
@@ -208,29 +208,33 @@
|
|
|
208
208
|
|
|
209
209
|
|
|
210
210
|
|
|
211
|
-
br = ThisWorkbook.Worksheets(lp).Cells(el
|
|
211
|
+
br = ThisWorkbook.Worksheets(lp).Cells(2, el)
|
|
212
212
|
|
|
213
213
|
|
|
214
214
|
|
|
215
|
+
openbooksheet.Activate
|
|
216
|
+
|
|
217
|
+
|
|
218
|
+
|
|
215
219
|
Selection.AutoFilter
|
|
216
220
|
|
|
217
221
|
openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br
|
|
218
222
|
|
|
219
223
|
|
|
220
224
|
|
|
221
|
-
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
|
|
225
|
+
LastRow = Cells(Selection.Rows.Count, 1).End(xlUp).Row
|
|
222
226
|
|
|
223
227
|
|
|
224
228
|
|
|
225
|
-
openbooksheet.Range("J2:J" & LastRow).Copy ThisWorkbook.Worksheets(lp).Range(
|
|
229
|
+
openbooksheet.Range("J2:J" & LastRow).Copy ThisWorkbook.Worksheets(lp).Range(ThisWorkbook.Worksheets(lp).Cells(3, el), ThisWorkbook.Worksheets(lp).Cells(3, el))
|
|
226
230
|
|
|
227
231
|
openbooksheet.Range("A1").AutoFilter
|
|
228
232
|
|
|
229
233
|
|
|
230
234
|
|
|
231
|
-
|
|
235
|
+
|
|
232
|
-
|
|
236
|
+
|
|
233
|
-
el = 1
|
|
237
|
+
el = el + 1
|
|
234
238
|
|
|
235
239
|
|
|
236
240
|
|
|
@@ -291,3 +295,7 @@
|
|
|
291
295
|
###補足情報
|
|
292
296
|
|
|
293
297
|
前回使用していたマクロを改変して作っているので謎の項目があるかもしれませんがご容赦ください。
|
|
298
|
+
|
|
299
|
+
追記１
|
|
300
|
+
|
|
301
|
+
あからさまにおかしい箇所が数点あったので修正しました。
|