こんにちは！ 健史です。
・複数のファイルを１つのファイルにシートを分けて集約する
・集約するシートにはひな形があり、ひな形のレイアウトにフォーマットを変換する
プログラムを作成しました。
上記の説明では分かりにくいと思いますので、以下の概要をご覧頂ければと思います。
尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。
Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。
実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)
概要
１.入力ファイル
1).所定フォルダに格納されているファイル
2).ひな形シートだけのファイル
2.処理結果
ひな形シートだけのファイルに入力ファイルの内容をコピー
プログラムの作成と実行
プログラム
'全ての拡張子を読み込む指定
Const cnsDIR = "\*.*"
'Excelを同時に3つ使うのでワークブックを定義、以降'WB'
Dim excel0, excel1, excel2 As Workbook
'添え字
Dim sht, ix1, ix1_max, ixt1, ixt2 As Long
'文字列検索用変数
Dim pos_st, pos_end, pos_len As Long
'ファイルパス名
Dim strPath1, strPath2, strFilename As String
'起動用WBをexcel0にセット
Set excel0 = ActiveWorkbook
'起動用WBのシート2をクリア
excel0.Sheets(2).Cells.Clear
'起動用WBから処理するパスをワークへセット
strPath1 = excel0.Sheets(1).Cells(1, 2)
strPath2 = excel0.Sheets(1).Cells(2, 2)
'上記でセットしたパスの存在チェック
If Dir(strPath1, vbDirectory) = "" Then
MsgBox "入力フォルダがない", vbExclamation
Exit Sub
End If
If Dir(strPath2, vbDirectory) = "" Then
MsgBox "ひな形(更新)ファイルがない", vbExclamation
Exit Sub
End If
'入力フォルダからファイル名を読み込み、起動用WBのシート２にセット
strFilename = Dir(strPath1 & cnsDIR, vbNormal)
ix1 = 0
Do While strFilename <> ""
ix1 = ix1 + 1
excel0.Sheets(2).Cells(ix1, 1) = strPath1 & "\" & strFilename
' 拡張子の前の"."の位置を求める
pos_end = InStr(1, strFilename, ".")
' IF文のElseに引っかかることはないが、念ための判定処理
If pos_end > 0 Then
pos_end = pos_end - 1
excel0.Sheets(2).Cells(ix1, 2) = Mid(strFilename, 1, pos_end)
Else
excel0.Sheets(2).Cells(ix1, 2) = strFilename
End If
strFilename = Dir()
Loop
'起動用WBのシート２の最大値を退避
ix1_max = ix1
'データ一覧WBをオープンして、excel1へセット
Workbooks.Open strPath2
Set excel1 = ActiveWorkbook
'起動用WBのシート２にプールしたファイルを1件ずつ読み込み、データ一覧WBへコピー
For ix1 = 1 To ix1_max
' 入力ファルダ内のデータファイルをオープンして、excel2へセット
Workbooks.Open excel0.Sheets(2).Cells(ix1, 1)
Set excel2 = ActiveWorkbook
' データ一覧WBのひな形シートを最後尾へコピー
excel1.Sheets(1).Copy After:=excel1.Sheets(excel1.Worksheets.Count)
' 最後尾へコピーしたシート名を起動用WBのシート２へセットしたファイル名に変更
excel1.Sheets(Worksheets.Count).Name = excel0.Sheets(2).Cells(ix1, 2)
' データ一覧WBへデータをコピー
excel1.Sheets(Worksheets.Count).Cells(1, 2) = excel0.Sheets(2).Cells(ix1, 2)
excel1.Sheets(Worksheets.Count).Cells(2, 2) = excel0.Sheets(2).Cells(ix1, 1)
ixt2 = 3
ixt1 = 5
Do Until excel2.Sheets(1).Cells(ixt2, 2) = ""
excel1.Sheets(Worksheets.Count).Cells(ixt1, 2) = excel2.Sheets(1).Cells(ixt2, 2)
excel1.Sheets(Worksheets.Count).Cells(ixt1, 3) = excel2.Sheets(1).Cells(ixt2, 3)
ixt2 = ixt2 + 1
ixt1 = ixt1 + 1
Loop
' 入力ファルダ内のデータファイルをクローズ
excel2.Close
Next
' データ一覧WBを上書き保存してクローズ
excel1.Save
excel1.Close
' 起動用WBを上書き保存
excel0.Save
'最後はすべてのExcelを終了
Application.Quit
実行してみよう
1.データ
1).入力データ用フォルダ作成
2).入力データ作成
以下3つのサンプルデータを入力データ用フォルダに作成します。ファイル名は好みで付けて頂ければと思います。
コピーしてペーストするときは、Excelシートのセル：A1で[右クリック]-[形式を選択して貼り付け(S)]から[貼り付ける形式(A)]に"テキスト"を選択します。
見出し１ 見出し２ 項目１１ 項目１-1 項目１２ 項目１-2 項目１３ 項目１-3 項目１４ 項目１-4 項目１５ 項目１-5 項目１６ 項目１-6 項目１７ 項目１-7 項目１８ 項目１-8 項目１９ 項目１-9 項目２０ 項目１-10
見出し１ 見出し２ 項目２１ 項目２-1 項目２２ 項目２-2 項目２３ 項目２-3 項目２４ 項目２-4 項目２５ 項目２-5 項目２６ 項目２-6
見出し１ 見出し２ 項目３１ 項目３-1 項目３２ 項目３-2 項目３３ 項目３-3 項目３４ 項目３-4 項目３５ 項目３-5 項目３６ 項目３-6 項目３７ 項目３-7 項目３８ 項目３-8
3).集約するファイルにひな形シートを作成
以下をコピー＆ペーストし集約するファイルを作成します。
ファイル名 リンク データ 見出し１ 見出し２
4).プログラム起動用ファイルを作成
①.シート１に入力フォルダ、集約するファイルのリンクを設定します。
セル：B1に「1).入力データ用フォルダ作成」で作成した[入力フォルダ]、セル：B2に「3).集約するファイルにひな形シートを作成」した[ファイル名]のリンクを設定します。
②.シート２を作成しておきます。
このシートに入力データ用フォルダ内のファイル名のリンクと拡張子なしのファイル名を格納し、集約シートへの更新時に使用します。
③.プログラム起動用ファイルを保存
プログラムでプログラム起動用ファイルを保存する処理があるため、入力データ用フォルダ作成以外の場所に保存しておきます。
ファイルの種類(T)は"Excel マクロ有効ブック(*.xlsm)"です。Excel2003以前をご利用の方はそのまま"*.xls"形式で保存しておきます。
5).プログラムの実行
上記「プログラム起動用ファイルを作成」に引き続き、以下を実施します。
①.ALTを押した状態でF8を押下してVBAを起動します。
②.マクロ名を入力し(testとか)、[作成(C)]を押下します。
③上記プログラムをコピー＆ペーストします。
④.F5で実行します。
6.結果確認
上記[概要]-[2.処理結果]の通りになっていればＯＫです。
加えて、処理で使う中間データ、起動用ファイルのシート２の内容は以下です。
補足説明
詳細は、プログラム内のコメントをご覧頂ければと思います。
入力ファイルのコピー元やコピー先の開始位置は、「"Const"で定義した変数を使用する」や「起動ファイルの入力フォルダ名などを設定するシートで設定した値を使用する」ようにしたほうが良いのでしょうが、今回はプログラム内にオンコーディングしました。
実際には、コピー項目が複数あったり、コピー元とコピー先の開始位置の列位置が連続していなかったり、場合によっては行開始位置もまちまちの可能性があるからです。
また、紹介用プログラムであり、変数化により理解しにくいプログラムになることを懸念してのことです。
最後に
今回紹介したプログラムは、１つのファイルにシートを追加していく処理でした。
以下の記事で紹介したシートではなく「ファイルを作成していく」プログラムも参考にして頂ければと思います。
コメント