EXCEL VBA

Excel-VBA 複数のファイルをひとつのファイルの複数シートに集約する

EXCEL VBA

こんにちは! 健史です。

・複数のファイルを1つのファイルにシートを分けて集約する
・集約するシートにはひな形があり、ひな形のレイアウトにフォーマットを変換する

プログラムを作成しました。

上記の説明では分かりにくいと思いますので、以下の概要をご覧頂ければと思います。

尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。

Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。

Excel-VBA 実例 この通りやれば動く、とにかく触ってみよう
こんにちは! 健史です。 パソコンをお使いの方の多くは、表計算ソフトExcelを利用されていると思います。 この記事は、Exceは知っているけれど ・Excel-VBAって何? ・Excel-VBAは取っ付きにくい! ・Excel-VBAっ...

実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)

スポンサーリンク

概要

1.入力ファイル

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のシート2にセット
    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のシート2の最大値を退避
    ix1_max = ix1
'データ一覧WBをオープンして、excel1へセット
    Workbooks.Open strPath2
    Set excel1 = ActiveWorkbook
'起動用WBのシート2にプールしたファイルを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のシート2へセットしたファイル名に変更
        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
	項目11	項目1-1
	項目12	項目1-2
	項目13	項目1-3
	項目14	項目1-4
	項目15	項目1-5
	項目16	項目1-6
	項目17	項目1-7
	項目18	項目1-8
	項目19	項目1-9
	項目20	項目1-10
		
	見出し1	見出し2
	項目21	項目2-1
	項目22	項目2-2
	項目23	項目2-3
	項目24	項目2-4
	項目25	項目2-5
	項目26	項目2-6
		
	見出し1	見出し2
	項目31	項目3-1
	項目32	項目3-2
	項目33	項目3-3
	項目34	項目3-4
	項目35	項目3-5
	項目36	項目3-6
	項目37	項目3-7
	項目38	項目3-8

3).集約するファイルにひな形シートを作成
以下をコピー&ペーストし集約するファイルを作成します。

ファイル名		
リンク		
		
データ	見出し1	見出し2

4).プログラム起動用ファイルを作成
①.シート1に入力フォルダ、集約するファイルのリンクを設定します。

セル:B1に「1).入力データ用フォルダ作成」で作成した[入力フォルダ]、セル:B2に「3).集約するファイルにひな形シートを作成」した[ファイル名]のリンクを設定します。

②.シート2を作成しておきます。

このシートに入力データ用フォルダ内のファイル名のリンクと拡張子なしのファイル名を格納し、集約シートへの更新時に使用します。

③.プログラム起動用ファイルを保存
プログラムでプログラム起動用ファイルを保存する処理があるため、入力データ用フォルダ作成以外の場所に保存しておきます。

ファイルの種類(T)は"Excel マクロ有効ブック(*.xlsm)"です。Excel2003以前をご利用の方はそのまま"*.xls"形式で保存しておきます。

5).プログラムの実行
上記「プログラム起動用ファイルを作成」に引き続き、以下を実施します。
①.ALTを押した状態でF8を押下してVBAを起動します。

②.マクロ名を入力し(testとか)、[作成(C)]を押下します。

③上記プログラムをコピー&ペーストします。

④.F5で実行します。

6.結果確認
上記[概要]-[2.処理結果]の通りになっていればOKです。

加えて、処理で使う中間データ、起動用ファイルのシート2の内容は以下です。

補足説明

詳細は、プログラム内のコメントをご覧頂ければと思います。

入力ファイルのコピー元やコピー先の開始位置は、「"Const"で定義した変数を使用する」や「起動ファイルの入力フォルダ名などを設定するシートで設定した値を使用する」ようにしたほうが良いのでしょうが、今回はプログラム内にオンコーディングしました。

実際には、コピー項目が複数あったり、コピー元とコピー先の開始位置の列位置が連続していなかったり、場合によっては行開始位置もまちまちの可能性があるからです。

また、紹介用プログラムであり、変数化により理解しにくいプログラムになることを懸念してのことです。

最後に

今回紹介したプログラムは、1つのファイルにシートを追加していく処理でした。

以下の記事で紹介したシートではなく「ファイルを作成していく」プログラムも参考にして頂ければと思います。

Excel-VBA 実例 ファイル名を読み込み参照・編集し別ファイル出力
こんにちは! 健史です。 複数のExcelファイルを入力として、ひな形ファイルに合わせて、全入力分のExcelファイルを作成しなければならない ということありませんか。 例えば「顧客別のExcelファイルから、返信シートを1人ひとり分作成し...
EXCEL VBA
スポンサーリンク
- 面白かったらシェアお願いします! -
健史をフォローする
自分で改善

コメント