エクセル マクロ csvファイル統合

質問

あるソフトを用いて指定行数に分割した15のcsvファイルをそれぞれシート別にしてエクセルファイルに取り込みたいと考えています。

マクロを用いてこのような作業を行いたいのですが何方かご教授いただけませんでしょうか？

回答No.3

Hydorogen · ベストアンサー

素人がの私が自分のスキルupのために考えて作って
みたものですので完璧では無いかもしれませんが記載致します。
===動作例====================================================
「ファイルを開く」ダイアログが開いて、任意のcsvファイルを
マウス等で複数選択し、「開く」ボタンを押します。ダイアログ
上のファイル（下記のは例としてのファイル名です）の並びが
No01.csv
No02.csv
No03.csv
No04.csv
と表示されているファイル名を上からマウスで選択を行った場合、
完成される合成csvファイルのシートの並びは
No01　No02　No03　No04
となり、下からマウスで複数選択した場合は完成される合成csv
ファイルのシートの並びは
No04　No03　No02　No01
となります。いずれも最後に残るファイルのファイル名は最初に
マウスで選択したものです。以上です。
============================================================
Sub Macro1()

'---ファイル名を取得するためのメソッド---------------------
F_name = Application.GetOpenFilename _
(Filefilter:="csvファイル(*.csv), *.csv", MultiSelect:=True)
'-------------------------------------------------------
F_no = UBound(F_name) '配列の要素数の確認
Workbooks.Open Filename:=F_name(1) '１つめ開く
Std_F = ActiveWorkbook.Name '基準を最初に開いたファイルに

For i = 2 To F_no '2つめから配列の要素数分まわす
Workbooks.Open Filename:=F_name(i) 'ファイル開く
Move_F = ActiveSheet.Name '開いたファイルのシート名記録
'↓基準ファイルに後から開いたファイルを移動↓
Sheets(Move_F).Move After:=Workbooks(Std_F).Sheets(i - 1)
Next i

End Sub

お礼

ありがとうございました。
シート順は逆になりましたが、ひとつに統合することができました。

回答No.2

imogasi

規約違反の丸投げコード作成依頼型質問なのでコードは書かない
（１）目的のCSVファイルの捕らえ方。質問にどういう状況ｋ書いてない。最悪ファイル名をシートにでも列挙入力。
あるフォルダのファイル全部とかあるフォルダのCSVファイル全てなど
が多いかとは思うが。それならVBSriptやDir関数をGoogoleで照会のこと。
（２）CSVファイルの読みこみ方
　　Open、レコードの最後を捉える方法、読んだ変数に入れる
　　そのEOFになるまで繰り返し。
（３）Split関数でカンマを区切りとして、項目データを配列に入れる。
（４）シートのｋ行の各列にSplit配列から順次データを代入
　　列を対象とした繰り返し。For j=1 to ○・・Next j
　　ｋ＝K+1　次は下の行に書き込む
（５）終わればCSVファイルをクローズ
（６）次のファイルに対し、（１）－（５）を繰り返し。
類似コードはwebなどに沢山ある。

お礼

ありがとうございました。

回答No.1

merlionXX

一例です。
その15件のCSVファイルが入っているフォルダーに以下のマクロを書いたエクセルBOOKを保存してください。（パス取得のため必ず「保存」してください。）
フォルダー内の全てのCSVファイルからデータをエクセルに１ファイルを１シートにして転記していきます。

Sub test01()
Dim MyFile As String, MyPath As String '変数宣言
Dim i As Long
Dim wb As Workbook
MyPath = ThisWorkbook.Path & "\" '自分のパスを取得
MyFile = Dir(MyPath & "*.csv", vbNormal) 'パス内のcsvファイル
Application.ScreenUpdating = False '画面更新停止
Application.Calculation = xlCalculationManual '自動計算停止
Do Until MyFile = "" '対象ファイルがなくなるまで
Set wb = Workbooks.Open(MyPath & "\" & MyFile) '選択したファイルを開く
Set ns = ThisWorkbook.Sheets.Add 'このBOOKにシートを追加
wb.Sheets(1).Cells.Copy ns.Cells(1, 1) '新規シートにコピペ
i = i + 1 'カウント
wb.Close (False) '選択したファイルを閉じる
MyFile = Dir '次のファイルを検索
Loop '繰り返し
Application.Calculation = xlCalculationAutomatic '自動計算停止解除
Application.ScreenUpdating = True '画面更新停止解除
Set wb = Nothing
Set ns = Nothing
MsgBox i & "件のCSVファイルから転記しました。", vbInformation, " " & Environ("UserName") & "さん (o^-')v "
End Sub