ここから本文です

複数のcsvを一つにまとめたくて、過去の知恵袋を参考に下記のコードをつくりました...

miy********さん

2018/1/3118:26:00

複数のcsvを一つにまとめたくて、過去の知恵袋を参考に下記のコードをつくりました。

画像のようにA1とA21にcsvファイル名が出るようになっているんですが、
これを、A列に出るようにしたいんです!

例>2018012021455Mのcsvには、19行のデーターが入っているので
A1からA19までに上記のcsvファイル名を表示・・・

宜しくお願い致します!!



Option Explicit
Dim cs, cv, f, gf, so
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(".")
Set cs = so.OpenTextFile(gf & "\Merge(csv).csv", 2, True)
For Each f In gf.Files
If LCase(so.GetExtensionName(f.Name)) = "csv" Then
Set cv = so.OpenTextFile(gf & "\" & f.Name, 1)
cs.WriteLine so.GetBaseName(f.Name)
cs.Write cv.ReadAll
cv.Close
Set cv = Nothing
End If
Next
cs.Close
Set cs = Nothing
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

投稿画像

閲覧数:
47
回答数:
2
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

lin********さん

2018/1/3119:10:33

こういうことでしょうか?

Option Explicit
Dim a, cs, cv, f, gf, so
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(".")
Set cs = so.OpenTextFile(gf & "\Merge(csv).csv", 2, True)
For Each f In gf.Files
If LCase(so.GetExtensionName(f.Name)) = "csv" and f.Name <> "Merge(csv).csv" Then
Set cv = so.OpenTextFile(gf & "\" & f.Name, 1)
Do Until cv.AtEndOfStream
a = cv.ReadLine
a = so.GetBaseName(f.Name) & "," & a
cs.WriteLine a
Loop
cv.Close
Set cv = Nothing
End If
Next
cs.Close
Set cs = Nothing
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

今回のような場合、「cv.ReadAll」のように、すべて読み込んでしまうと、思っておられる処理ができません。

そこで1行ずつ、読み込んで、読み込んだ1行の頭に「ファイル名+,」を付け足してから、「Merge(csv).csv」に出力しています。

あと、注意事項ですが、「Merge(csv).csv」ファイルが、同じフォルダ内に存在するため、その「Merge(csv).csv」を作成しながら、読み込んでしまい、処理が終了しないか、大変大きなファイルができてしまいます。

そこで、

If LCase(so.GetExtensionName(f.Name)) = "csv" and f.Name <> "Merge(csv).csv" Then

というように、「Merge(csv).csv」を除外することを忘れないでください。

では、お勉強、がんばってください。

質問した人からのコメント

2018/2/1 10:43:33

うまくできました!説明付で大変勉強になりました。

ベストアンサー以外の回答

1〜1件/1件中

hig********さん

2018/1/3119:16:41

データ処理の順番をまず考えます。
①A列に新たに1列挿入
②A2から下を、下記の要領で記入
・1つ上の行のC列(最初はC1)が空白なら、1つ上の行のB列を記入
・空白でないなら、1つ上のA列を記入
これを下まで埋める

③C列を見て空白なら行削除

columns("A").insert
for i=2 to cells(rows.count, "C").end(xlup).row
if cells(i-1, "C")="" then
cells(i, "A")=cells(i-1, "B")
else
cells(i, "A")=cells(i-1, "A")
end if
next i

for i=cells(rows.count, "C").end(xlup).row to 1 step -1
if cells(i, "C")="" then rows(i).delete
next i

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる