人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excel2003のマクロ・VBAに関しての質問です。

複数のCSVファイルから特定の行範囲のみを読み込み、
尚且つA列もしくは一番左の列に拡張子抜きでファイル名を入れたいです。
(どのCSVファイルも、取り出したいのは26-33行目のデータです)

例えば、
ファイル名:X1234567.CSV
中身:
Z1,1,100,2,200,3,300
Z2,4,400,5,500,6,600

ファイル名:Y8901234.CSV
中身:
Z1,7,700,8,800,9,900
Z2,10,1000,11,1100,12,1200

という場合は、

A B C D E F G H
1 X1234567 Z1 1 100 2 200 3 300
2 X1234567 Z2 4 400 5 500 6 600
3 Y8901234 Z1 7 700 8 800 9 900
4 Y8901234 Z2 10 1000 11 1100 12 1200

このような感じの表が出来れば、と思います。
処理を行いたいCSVファイルが約1000個もあり、手動での作業は厳しく
マクロ等で出来ると大変助かります。

どなたかお解りになる方、ぜひご回答下さい。

●質問者: zc31s
●カテゴリ:コンピュータ
✍キーワード:CSV VBA データ ファイル マクロ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● Mook
●1000ポイント ベストアンサー

指定行数のみ読む仕様ですが、下記のようでご希望通りになるでしょうか。


先頭のパスを CSV の入ったフォルダに変更して実行ください。

Option Explicit

Sub LoadCSVData()
 Const dataPath = "C:\CSVData"  '★★★ 実際のフォルダ名に変更

 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 Dim objFile As Object
 
 Dim r As Long
 r = 1
 Dim c As Long
 
 Dim lData As Variant
 Dim lNum As Long
 
 For Each objFile In fso.GetFolder(dataPath).Files
 If UCase(fso.GetExtensionName(objFile.Path)) = "CSV" Then
 With objFile.OpenAsTextStream
 lNum = 1
 Do While .AtEndOfLine <> True
 Select Case True
 Case lNum >= 26 And lNum <= 33  '--- データ読込み対象行
 Cells(r, 1).Value = Replace(UCase(objFile.Name), ".CSV", "")
 lData = Split(.ReadLine, ",")
 For c = LBound(lData) To UBound(lData)
 Cells(r, c + 2).Value = lData(c)
 Next
 r = r + 1
 Case lNum > 33
 Exit Do
 Case Else
 .ReadLine
 End Select
 lNum = lNum + 1
 Loop
 End With
 End If
 Next
End Sub
◎質問者からの返答

最高!完璧です!ありがとうございました!

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ