TTak's Office Excel 同じ書式のファイルを統合したい(EXCEL2010)

　同じ書式のファイルを統合したい
　

　　
要VBA/サンプル有

○考え方

　営業所や事業部別の業務ファイル、測定データなど、大量のデータがファイル別になっていることはよくあります。これらのファイルを統合して一括計算処理をすることが日頃の業務になっている方も多いことでしょう。そんなときファイルを統合するマクロが有れば便利です。

　このマクロでは、フィールド数と科目の順序が同じ（行数のみ変化）ファイルを統合するために作ったものです。まず、各データが何行目まであるかを確かめ、そのデータ範囲だけをコピーして、一括処理用のシートに張り付けます。一括処理用のシートの行数も増えていきますので、その都度データが何行目まであるかを確かめ、最下段の次の行に新しいデータを張り付けるようにマクロを組みます。順序立てると次のようになります。

ファイル1を開く＞ファイル1のデータ範囲取得＞データ範囲コピー＞
処理ファイルに張付け＞ファイル1を閉じる＞
処理ファイルのデータ範囲取得＞
ファイル2を開く＞ファイル2のデータ範囲取得＞データ範囲コピー＞
処理ファイルのデータ範囲の次行から張付け＞ファイル2を閉じる＞
処理ファイルのデータ範囲取得＞
ファイル3を開く＞ファイル3のデータ範囲取得＞データ範囲コピー＞
処理ファイルのデータ範囲の次行から張付け＞ファイル3を閉じる＞
処理ファイルのデータ範囲取得＞
（ループ）

○ポイントはデータ最下段判定

(1) 指定した列に何行目までデータが入っているかを調べる関数を作る。
　　コード例はデータの最下段・最右列を返すユーザー定義関数を参照

(2) 統合コード例は下記。

Function Myrec(c As Integer) As Integer
'データ行数の取得ユーザー定義関数
'cは行数を取得するのが何列目かを指定
Myrec = ActiveSheet.Range(ActiveSheet.Cells(ActiveSheet.Rows.Count, c) _
  .End(xlUp).Address).Row
End Function

Sub DATAFILE_PLUS()
Sub DATAFILE_PLUS2007()
Dim myName As String
Dim c As Integer '<何列目の行数を基準とするか
Dim f As Integer '<何行目からのデータを取得するか
Dim f2 As Integer
Dim maxc As Integer '<何列目までのデータを取得するか
Dim actvSh As Integer '<何番目のシートのデータを取得するか
Dim openFilePath As String '<作業フォルダのパス
Dim meMaxR As Integer '<自身のデータが何行目までか
Dim opMaxR As Integer '<開いたデータが何行目までか

c = 1
f = 2
maxc = 4
actvSh = 1

openFilePath = "データフォルダまでのパスを入力してください"
'openFilePath = InputBox("データフォルダまでのパスを入力してください")
myName = Dir(openFilePath & "\*.xls") '-EXCELバージョンに応じて拡張子を変更してください
Do While myName <> ""
      Application.ScreenUpdating = True
      If MsgBox(myName & "を統合しますか?", _
          vbQuestion + vbYesNo) = vbYes Then
         meMaxR = Myrec(c)
         Application.ScreenUpdating = False
         Workbooks.Open openFilePath & "\" & myName
         Sheets(actvSh).Activate
         opMaxR = Myrec(c)
         f2 = opMaxR - (f - 1)
         With ThisWorkbook.Sheets(1)
           .Range(.Cells(meMaxR + 1, 1), _
             .Cells(meMaxR + f2, maxc)).Value = _
            ActiveSheet.Range(ActiveSheet.Cells(f, 1), _
             ActiveSheet.Cells(opMaxR, maxc)).Value
         End With
         ActiveWorkbook.Close False
      End If
    myName = Dir
Loop
End Sub

○こんな時に使える

・たくさんある同じフォーマットのデータを統合したい
・同じフォルダ内のデータを統合したい

○応用またはその他の方法

・EXCEL2000の場合はこちら
・データの最下段・最右列を返すユーザー定義関数

○サンプル

・サンプルファイルはこちら（要解凍） 17KB

○注意

統合するファイルは、科目・フィールドが同じ順序になっている必要があります。
作業フォルダにネットワークパスを指定する場合は、アクセス権などのメッセージでマクロが止まる場合があります。

Excel2003まではFileSearchメソッドが使えます。サンプルファイルのマクロを参考にしてください。