回答編集履歴

4

ああ

2021/01/11 13:19

投稿

KazuSaka
KazuSaka

スコア640

test CHANGED
@@ -674,7 +674,7 @@
674
674
 
675
675
  CSVファイルのみを対象にする
676
676
 
677
- '''VBS
677
+ ```VBS
678
678
 
679
679
  '========================
680
680
 
@@ -726,4 +726,4 @@
726
726
 
727
727
  End Sub
728
728
 
729
- '''
729
+ ```

3

2021/01/11 13:18

投稿

KazuSaka
KazuSaka

スコア640

test CHANGED
@@ -667,3 +667,63 @@
667
667
  End Sub
668
668
 
669
669
  ```
670
+
671
+
672
+
673
+ ### 追記3
674
+
675
+ CSVファイルのみを対象にする
676
+
677
+ '''VBS
678
+
679
+ '========================
680
+
681
+ ' リスト取得プロシージャ
682
+
683
+ '========================
684
+
685
+ Sub GetFiles(ByVal folderPath, ByRef fileList)
686
+
687
+ Dim objFileSys
688
+
689
+ Dim objFolder
690
+
691
+ Dim objFile
692
+
693
+ Dim i
694
+
695
+ i = 0
696
+
697
+
698
+
699
+ Set objFileSys = CreateObject("Scripting.FileSystemObject")
700
+
701
+ Set objFolder = objFileSys.GetFolder(folderPath)
702
+
703
+
704
+
705
+ For Each objFile In objFolder.Files
706
+
707
+ IF objFileSys.GetExtensionName(objFile.Name)="csv" Then
708
+
709
+ '取得したファイルのファイル名を表示
710
+
711
+ redim Preserve fileList(i)
712
+
713
+ fileList(i) = folderPath & "/" & objFile.Name
714
+
715
+ i = i + 1
716
+
717
+ End If
718
+
719
+ Next
720
+
721
+
722
+
723
+ Set objFolder = Nothing
724
+
725
+ Set objFileSys = Nothing
726
+
727
+ End Sub
728
+
729
+ '''

2

2021/01/11 12:49

投稿

KazuSaka
KazuSaka

スコア640

test CHANGED
@@ -403,3 +403,267 @@
403
403
 
404
404
 
405
405
  ```
406
+
407
+
408
+
409
+ ### 追記2
410
+
411
+ ANSI形式のCSVファイルを読み込めるように、ReadFileプロシージャを変更しました。
412
+
413
+ 出力ファイルの形式もANSI形式になるように変更しました。
414
+
415
+
416
+
417
+ 変更箇所
418
+
419
+ ①WriteFileANSIプロシージャ追加
420
+
421
+ ②ReadFileプロシージャ変更
422
+
423
+
424
+
425
+ ```VBS
426
+
427
+ Option Explicit
428
+
429
+
430
+
431
+ '===========
432
+
433
+ ' メイン処理
434
+
435
+ '===========
436
+
437
+ Dim LineArrM
438
+
439
+ Dim LineArrTemp()
440
+
441
+ Dim CSV_PATH()
442
+
443
+ Dim i
444
+
445
+
446
+
447
+ GetFiles "./CSV", CSV_PATH '※フォルダ以下のCSVファイルパスを取得
448
+
449
+ For i = 0 To UBound(CSV_PATH)
450
+
451
+ ReadFile CSV_PATH(i), LineArrTemp '※ファイルのデータを配列に格納
452
+
453
+ If i = 0 then
454
+
455
+ LineArrM = LineArrTemp '※1ファイル目
456
+
457
+ Else
458
+
459
+ ListMerge LineArrTemp, LineArrM '※2ファイル目以降は重複をチェックしてマージ
460
+
461
+ End If
462
+
463
+ Next
464
+
465
+
466
+
467
+ WriteFileANSI "outputText.csv", LineArrM 'ファイル出力(ANSI)
468
+
469
+ 'WriteFile "outputText.csv", LineArrM 'ファイル出力(UTF-8)
470
+
471
+
472
+
473
+ '<メイン処理はここまで>
474
+
475
+
476
+
477
+
478
+
479
+ '<以下はSubプロシージャ>
480
+
481
+ '========================
482
+
483
+ ' ファイル書き込み(UTF-8)
484
+
485
+ '========================
486
+
487
+ Sub WriteFile(ByVal outputPath, ByVal arr)
488
+
489
+ Dim output, i
490
+
491
+ Set output = CreateObject("ADODB.Stream")
492
+
493
+ output.Type = 2
494
+
495
+ output.Charset = "UTF-8"
496
+
497
+ output.Open
498
+
499
+
500
+
501
+ for i = 0 To UBound(arr)
502
+
503
+ output.WriteText arr(i), 1 '[0:改行なし 1:改行コード付加]
504
+
505
+ Next
506
+
507
+ output.SaveToFile outputPath, 2
508
+
509
+ output.Close
510
+
511
+ End Sub
512
+
513
+
514
+
515
+ '========================
516
+
517
+ ' ファイル書き込み(ANSI)
518
+
519
+ '========================
520
+
521
+ Sub WriteFileANSI(ByVal outputPath, ByVal arr)
522
+
523
+ Dim outputFile, fso
524
+
525
+ Set fso = WScript.CreateObject("Scripting.FileSystemObject")
526
+
527
+ Set outputFile = fso.OpenTextFile(outputPath, 2, True)
528
+
529
+ for i = 0 To UBound(arr)
530
+
531
+ outputFile.WriteLine arr(i)
532
+
533
+ Next
534
+
535
+
536
+
537
+ outputFile.Close
538
+
539
+ End Sub
540
+
541
+
542
+
543
+ '===================
544
+
545
+ ' 重複を削除+マージ
546
+
547
+ '===================
548
+
549
+ Sub ListMerge(ByVal arrTemp, ByRef arrM)
550
+
551
+ Dim i,j
552
+
553
+ '※配列Tempで配列Mにない要素だけ配列Mに追加する
554
+
555
+ For i = 0 To UBound(arrTemp)
556
+
557
+ For j = 0 To UBound(arrM)
558
+
559
+ if arrTemp(i) <> arrM(j) then
560
+
561
+ '※配列Mにないものは追加
562
+
563
+ if UBound(arrM) = j then
564
+
565
+ redim Preserve arrM(UBound(arrM) + 1) '配列を+1拡張
566
+
567
+ arrM(UBound(arrM)) = arrTemp(i)
568
+
569
+ End If
570
+
571
+ Else
572
+
573
+ '※配列Mにあるものは追加しない
574
+
575
+ Exit For
576
+
577
+ End If
578
+
579
+ Next
580
+
581
+ Next
582
+
583
+ End Sub
584
+
585
+
586
+
587
+ '========================
588
+
589
+ ' リスト取得プロシージャ
590
+
591
+ '========================
592
+
593
+ Sub GetFiles(ByVal folderPath, ByRef fileList)
594
+
595
+ Dim objFileSys
596
+
597
+ Dim objFolder
598
+
599
+ Dim objFile
600
+
601
+ Dim i
602
+
603
+ i = 0
604
+
605
+
606
+
607
+ Set objFileSys = CreateObject("Scripting.FileSystemObject")
608
+
609
+ Set objFolder = objFileSys.GetFolder(folderPath)
610
+
611
+
612
+
613
+ For Each objFile In objFolder.Files
614
+
615
+ '取得したファイルのファイル名を表示
616
+
617
+ redim Preserve fileList(i)
618
+
619
+ fileList(i) = folderPath & "/" & objFile.Name
620
+
621
+ i = i + 1
622
+
623
+ Next
624
+
625
+
626
+
627
+ Set objFolder = Nothing
628
+
629
+ Set objFileSys = Nothing
630
+
631
+ End Sub
632
+
633
+
634
+
635
+ '==================================
636
+
637
+ ' CSV読み込みプロシージャ(ANSI専用)
638
+
639
+ '==================================
640
+
641
+ Sub ReadFile(ByVal filePath, ByRef dataList)
642
+
643
+ Dim fso,i
644
+
645
+ Dim inputFile
646
+
647
+ Set fso = WScript.CreateObject("Scripting.FileSystemObject")
648
+
649
+ Set inputFile = fso.OpenTextFile(filePath, 1, False, 0)
650
+
651
+ i=0
652
+
653
+ Do Until inputFile.AtEndOfStream
654
+
655
+ redim Preserve dataList(i)
656
+
657
+ dataList(i) = inputFile.ReadLine
658
+
659
+ i = i + 1
660
+
661
+ Loop
662
+
663
+
664
+
665
+ inputFile.Close
666
+
667
+ End Sub
668
+
669
+ ```

1

追記

2021/01/09 14:19

投稿

KazuSaka
KazuSaka

スコア640

test CHANGED
@@ -159,3 +159,247 @@
159
159
 
160
160
 
161
161
  ```
162
+
163
+
164
+
165
+ ### 追記
166
+
167
+ 実行ファイルと同じ階層の「CSV」フォルダ以下のファイルを対象に重複削除・ファイル出力の処理を作ってみました。「CSV」フォルダ以下にCSVファイルを配置して試してみてください。CSVファイルはUTF-8にしてください。
168
+
169
+
170
+
171
+ ```VBS
172
+
173
+ Option Explicit
174
+
175
+
176
+
177
+ '===========
178
+
179
+ ' メイン処理
180
+
181
+ '===========
182
+
183
+ Dim LineArrM
184
+
185
+ Dim LineArrTemp()
186
+
187
+ Dim CSV_PATH()
188
+
189
+ Dim i
190
+
191
+
192
+
193
+ GetFiles "./CSV", CSV_PATH '※フォルダ以下のCSVファイルパスを取得
194
+
195
+
196
+
197
+ For i = 0 To UBound(CSV_PATH)
198
+
199
+ ReadFile CSV_PATH(i), LineArrTemp '※ファイルのデータを配列に格納
200
+
201
+ If i = 0 then
202
+
203
+ LineArrM = LineArrTemp '※1ファイル目
204
+
205
+ Else
206
+
207
+ ListMerge LineArrTemp, LineArrM '※2ファイル目以降は重複をチェックしてマージ
208
+
209
+ End If
210
+
211
+ Next
212
+
213
+
214
+
215
+ WriteFile "outputText.csv", LineArrM 'ファイル出力
216
+
217
+ '<メイン処理はここまで>
218
+
219
+
220
+
221
+
222
+
223
+ '<以下はSubプロシージャ>
224
+
225
+ '===================
226
+
227
+ ' ファイル書き込み
228
+
229
+ '===================
230
+
231
+ Sub WriteFile(ByVal outputPath, ByVal arr)
232
+
233
+ Dim output, i
234
+
235
+ Set output = CreateObject("ADODB.Stream")
236
+
237
+ output.Type = 2
238
+
239
+ output.Charset = "UTF-8"
240
+
241
+ output.Open
242
+
243
+
244
+
245
+ for i = 0 To UBound(arr)
246
+
247
+ output.WriteText arr(i), 1 '[0:改行なし 1:改行コード付加]
248
+
249
+ Next
250
+
251
+ output.SaveToFile outputPath, 2
252
+
253
+ output.Close
254
+
255
+ End Sub
256
+
257
+
258
+
259
+ '===================
260
+
261
+ ' 重複を削除+マージ
262
+
263
+ '===================
264
+
265
+ Sub ListMerge(ByVal arrTemp, ByRef arrM)
266
+
267
+ Dim i,j
268
+
269
+ '※配列Tempで配列Mにない要素だけ配列Mに追加する
270
+
271
+ For i = 0 To UBound(arrTemp)
272
+
273
+ For j = 0 To UBound(arrM)
274
+
275
+ if arrTemp(i) <> arrM(j) then
276
+
277
+ '※配列Mにないものは追加
278
+
279
+ if UBound(arrM) = j then
280
+
281
+ redim Preserve arrM(UBound(arrM) + 1) '配列を+1拡張
282
+
283
+ arrM(UBound(arrM)) = arrTemp(i)
284
+
285
+ End If
286
+
287
+ Else
288
+
289
+ '※配列Mにあるものは追加しない
290
+
291
+ Exit For
292
+
293
+ End If
294
+
295
+ Next
296
+
297
+ Next
298
+
299
+ End Sub
300
+
301
+
302
+
303
+ '========================
304
+
305
+ ' リスト取得プロシージャ
306
+
307
+ '========================
308
+
309
+ Sub GetFiles(ByVal folderPath, ByRef fileList)
310
+
311
+ Dim objFileSys
312
+
313
+ Dim objFolder
314
+
315
+ Dim objFile
316
+
317
+ Dim i
318
+
319
+ i = 0
320
+
321
+
322
+
323
+ Set objFileSys = CreateObject("Scripting.FileSystemObject")
324
+
325
+ Set objFolder = objFileSys.GetFolder(folderPath)
326
+
327
+
328
+
329
+ For Each objFile In objFolder.Files
330
+
331
+ '取得したファイルのファイル名を表示
332
+
333
+ redim Preserve fileList(i)
334
+
335
+ fileList(i) = folderPath & "/" & objFile.Name
336
+
337
+ i = i + 1
338
+
339
+ Next
340
+
341
+
342
+
343
+ Set objFolder = Nothing
344
+
345
+ Set objFileSys = Nothing
346
+
347
+ End Sub
348
+
349
+
350
+
351
+ '========================
352
+
353
+ ' CSV読み込みプロシージャ
354
+
355
+ '========================
356
+
357
+ Sub ReadFile(ByVal filePath, ByRef dataList)
358
+
359
+ Dim input
360
+
361
+ Set input = CreateObject("ADODB.Stream")
362
+
363
+ input.Open
364
+
365
+ input.Type = 2
366
+
367
+ input.Charset = "UTF-8"
368
+
369
+ input.LineSeparator = 10
370
+
371
+ input.LoadFromFile filePath
372
+
373
+
374
+
375
+ '対象ファイルから1行ずつ読み込む
376
+
377
+ Dim line
378
+
379
+ Dim aryStrings
380
+
381
+ Dim i
382
+
383
+ i = 0
384
+
385
+ Do Until input.EOS
386
+
387
+ line = input.ReadText(-2)
388
+
389
+ redim Preserve dataList(i)
390
+
391
+ dataList(i) = Replace(line, vbCr, "") '改行コード削除(書込時に改行コード付加)
392
+
393
+ i = i + 1
394
+
395
+ Loop
396
+
397
+
398
+
399
+ input.Close
400
+
401
+ End Sub
402
+
403
+
404
+
405
+ ```