【Excel+VBA】複数ファイルのレコードをマージしてひとつのファイルにする

　Excelの複数のファイルにレコードを、１つのファイルにマージするためのVBAを作成しました。

「営業担当者ごとの今月の受注データをひとつにまとめて、部全体の受注データを作成する」といった作業を行う場合、ファイルをひとつずつ開いてコピペするのは地味に面倒な作業です。
仮に「ひとつのファイルを開く⇒コピペする⇒ファイルを閉じる」の一連の作業に１分かかるとして、１０人分だと１０分、１００人分だと１００分もかかる作業です。

　単純な作業は自動化しましょう。

この記事でできること
  • Excelの複数ファイルを自動集計できる。

完成形

　以下が完成形です。詳細はのちほど解説します。

Public Const SHEET_FROM = "Sheet1"         ' マージするデータが保存されているシート名
Public Const SHEET_TO = "マージ後"         ' マージ後のデータを保存するシート名
Public COLUMN_END  As Long                 ' 最大カラム数

Public Function MergerFiles()

    Dim File As String

    COLUMN_END = Columns.Count

    ' マージする対象のファイルの場所
    FILE_PATH = ThisWorkbook.Path
    FILE_PATH_FROM = FILE_PATH & "\From"

    '　ヘッダから下のデータをクリア
    ThisWorkbook.Sheets(SHEET_TO).Range(Cells(2, 1), Cells(Rows.Count, COLUMN_END)).Clear

    ' ファイルがあるだけループ
    File = Dir(FILE_PATH_FROM & "\*.xlsx")
    Do While File <> ""
        MergeFile Path:=FILE_PATH_FROM & "\" & File
        File = Dir()
    Loop

End Function

Private Function MergeFile(Path As String)

    Dim BookFrom As Workbook

    Set BookFrom = Workbooks.Open(Filename:=Path, ReadOnly:=True, UpdateLinks:=False)
    
    Set SheetFrom = BookFrom.Sheets(SHEET_FROM)
    Set SheetTo = ThisWorkbook.Sheets(SHEET_TO)
    
    ' マージ元の行数(ヘッダを含む)
    With SheetFrom
        RowsFrom = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    ' マージ先の行数(ヘッダを含む)
    With SheetTo
        RowsTo = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    ' コピー元の範囲(ヘッダの次の行から最後の行まで)
    Set RangeFrom = SheetFrom.Range(SheetFrom.Cells(2, 1), SheetFrom.Cells(RowsFrom, COLUMN_END))
    ' コピー先の範囲(最終行の次の行から、コピー元の行数分)
    Set RangeTo = SheetTo.Range(SheetTo.Cells(RowsTo + 1, 1), SheetTo.Cells(RowsTo + RowsFrom - 1, COLUMN_END))
    
    RangeTo.Value = RangeFrom.Value
    
    BookFrom.Close SaveChanges:=False

End Function

解説

　VBAの中で分かりにくそうな箇所を解説します。

ヘッダから下のデータをクリア

    '　ヘッダから下のデータをクリア
    ThisWorkbook.Sheets(SHEET_TO).Range(Cells(2, 1), Cells(Rows.Count, COLUMN_END)).Clear

　ここでは、マージ後のデータ格納領域のクリアを行っています。

「Range(Cells(2, 1), Cells(Rows.Count, COLUMN_END))」が、クリア対象となる領域です。ヘッダ行の次の行である２行目から、データが格納されている最終行までを指しています。

下図を例にすると、Cells(2,1)はA2のセル、Cells(Rows.Count, COLUMN_END)は、４行目の右端のセルを表しています。

赤枠の中をクリア

行数

    ' マージ元の行数(ヘッダを含む)
    With SheetFrom
        RowsFrom = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    ' マージ先の行数(ヘッダを含む)
    With SheetTo
        RowsTo = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

　コピペをするには「コピー元の行数」と「貼り付け先の最初の行の位置」の情報が必要になります。

上記では、A列の一番下のセルから「Ctrl+↑」で最終行に移動する要領で、コピー元・貼り付け先それぞれのヘッダ行を含む行数(最終行の行番号)を取得しています。

貼り付け

    ' コピー元の範囲(ヘッダの次の行から最後の行まで)
    Set RangeFrom = SheetFrom.Range(SheetFrom.Cells(2, 1), SheetFrom.Cells(RowsFrom, COLUMN_END))
    ' コピー先の範囲(最終行の次の行から、コピー元の行数分)
    Set RangeTo = SheetTo.Range(SheetTo.Cells(RowsTo + 1, 1), SheetTo.Cells(RowsTo + RowsFrom - 1, COLUMN_END))
    
    RangeTo.Value = RangeFrom.Value

　コピペを一括で行っています。

　For文などで１行ずつコピーして貼り付ける方法もありますが、その方法だと時間がかかりすぎるため、コピーする範囲を一括選択して貼り付けるようにしています。

　下図を例にすると、コピー元の行数が３行であるため、貼り付け先の領域は４～６行目になります。

まとめ

　今回紹介した内容は、コピペに最低限必要な部分を記載しました。

必要に応じて、マージボタンを追加したり、コピー元のファイルのオープン・クローズを見せないようにしたり、カスタイマイズしていただければと思います。

参考になればうれしいです。

コメント