複数のシートをもつ複数のエクセルファイルのデータ合成（各Sheet毎に）

質問

4つの「Sheet」があるエクセルファイルが100個ほどあります。すべて同じ書式のデータです。それぞれの「Sheet」ごとに、データを合成したいのですが、簡単な方法がありませんでしょうか。簡単に言えば、「Sheet」毎のデータの合成です。例えば、100個のエクセルファイルの「Sheet1」の情報を一つのシートに、「Sheet2」の情報を別途のシートに合成するという具合です。かなり困っています。できれば無料でできる方法を教えて頂ければ幸いです。よろしくお願いします。

回答No.7

CaveatEmptor · ベストアンサー

それぞれのファイルの中のシート名が同じなら、次のマクロを使ってください。例として、Sheet1～Sheet4を「研究」、「調査」、「報告」、「会計」というシート名ということにしています。マクロの下の部分を適当に書き換えて下さい。

MySheet(1) = "研究"
MySheet(2) = "調査"
MySheet(3) = "報告"
MySheet(4) = "会計"

Sub DataCollection()
Dim MySheet(4) As String

filepath = "D:\work"
Databook = ActiveWorkbook.Name

Application.DisplayAlerts = False
Application.ScreenUpdating = False

MySheet(1) = "研究"
MySheet(2) = "調査"
MySheet(3) = "報告"
MySheet(4) = "会計"

i = 1
Do While Not (IsEmpty(Workbooks(Databook).Sheets("Sheet5").Cells(i, 1)))
　　Mybook = Workbooks(Databook).Sheets("Sheet5").Cells(i, 1)
　　If Mybook <> "Data.xls" Then
　　　　Workbooks.Open filepath & "\" & Mybook
　　　　　　For j = 1 To 4
　　　　　　　　'シート１：4列(A-D)42行、利用（合成）したいデータは、D4:D42
　　　　　　　　If j = 1 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets(MySheet(j)).Select
　　　　　　　　　　Range(Cells(4, 4), Cells(42, 4)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets(MySheet(j)).Select
　　　　　　　　　　Cells(65536, 4).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　　　'シート２：19列(A-S)161行、利用（合成）したいデータは、E3とB8:S10
　　　　　　　　If j = 2 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets(MySheet(j)).Select
　　　　　　　　　　Range(Cells(3, 5), Cells(3, 5)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets(MySheet(j)).Select
　　　　　　　　　　Cells(65536, 5).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial

　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets(MySheet(j)).Select
　　　　　　　　　　Range(Cells(8, 2), Cells(10, 19)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets(MySheet(j)).Select
　　　　　　　　　　Cells(65536, 5).End(xlUp).Offset(1, -3).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　　　'シート３：35列(A-AI)303行、利用（合成）したいデータは、A4:AI303
　　　　　　　　If j = 3 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets(MySheet(j)).Select
　　　　　　　　　　Range(Cells(4, 1), Cells(303, 35)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets(MySheet(j)).Select
　　　　　　　　　　Cells(65536, 1).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　　　'シート４：13列(A-M)1003行、利用（合成）したいデータは、A4:M1003
　　　　　　　　If j = 4 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets(MySheet(j)).Select
　　　　　　　　　　Range(Cells(4, 1), Cells(1003, 13)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets(MySheet(j)).Select
　　　　　　　　　　Cells(65536, 1).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　Next
　　　　Workbooks(Mybook).Close False
　　End If
i = i + 1
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

お礼

できました。ありがとうございました。助かりました。一時はどうしようかと本当に悩んでました。期日に間に合いそうです。本当にありがとうございました。

回答No.8

CaveatEmptor

書き忘れました。

さきほどのマクロを貼り付けたファイルのSheet1～Sheet4も「研究」、「調査」、「報告」、「会計」というようにシート名をかえてから、実行して下さい。

回答No.6

CaveatEmptor

以下を試してみてください。

1.合成したいファイルをすべて一つのフォルダに入れて下さい。Ｄドライブのworkというフォルダに入れることを前提にマクロは組んでいます。他の場所で行う場合はマクロに２箇所あるfilepath = "D:\work"の部分を書き換えて下さい。

2.次に新規でエクセルのファイルを開いて、ワークシートを２つ追加してSheet1～Sheet5までを用意してください。

3.下のマクロを標準モジュールにコピペして下さい。合成したいファイルがあるフォルダと同じ場所に保存してから、もう一度開いて下さい。

4.[ツール]-[マクロ]-[マクロ]（または[Alt]を押しながら[F８]を押して）からFileListingのマクロを選択して実行します。Excel2003までだと65536行しかありませんので、シート４にあるデータは１ファイル1000行あると100ファイルのデータを合成することはできませんので、Sheet5にあるファイル名を減らす必要があります。

5.Sheet5にあるファイルの順番に追記されますので、必要があれば、ソートして下さい。

6.DataCollectionのマクロを実行すれば、Sheet1～Sheet4に合成されたデータが書き込まれます。

わかりにくかったらまた質問してください。

Sub DataCollection()
filepath = "D:\work"
Databook = ActiveWorkbook.Name

Application.DisplayAlerts = False
Application.ScreenUpdating = False

i = 1
Do While Not (IsEmpty(Workbooks(Databook).Sheets("Sheet5").Cells(i, 1)))
　　Mybook = Workbooks(Databook).Sheets("Sheet5").Cells(i, 1)
　　If Mybook <> "Data.xls" Then
　　　　Workbooks.Open filepath & "\" & Mybook
　　　　　　For j = 1 To 4
　　　　　　　　'シート１：4列(A-D)42行、利用（合成）したいデータは、D4:D42
　　　　　　　　If j = 1 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets("Sheet" & j).Select
　　　　　　　　　　Range(Cells(4, 4), Cells(42, 4)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets("Sheet" & j).Select
　　　　　　　　　　Cells(65536, 4).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　　　'シート２：19列(A-S)161行、利用（合成）したいデータは、E3とB8:S10
　　　　　　　　If j = 2 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets("Sheet" & j).Select
　　　　　　　　　　Range(Cells(3, 5), Cells(3, 5)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets("Sheet" & j).Select
　　　　　　　　　　Cells(65536, 5).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial

　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets("Sheet" & j).Select
　　　　　　　　　　Range(Cells(8, 2), Cells(10, 19)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets("Sheet" & j).Select
　　　　　　　　　　Cells(65536, 5).End(xlUp).Offset(1, -3).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　　　'シート３：35列(A-AI)303行、利用（合成）したいデータは、A4:AI303
　　　　　　　　If j = 3 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets("Sheet" & j).Select
　　　　　　　　　　Range(Cells(4, 1), Cells(303, 35)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets("Sheet" & j).Select
　　　　　　　　　　Cells(65536, 1).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　　　'シート４：13列(A-M)1003行、利用（合成）したいデータは、A4:M1003
　　　　　　　　If j = 4 Then
　　　　　　　　　　Workbooks(Mybook).Activate
　　　　　　　　　　Workbooks(Mybook).Sheets("Sheet" & j).Select
　　　　　　　　　　Range(Cells(4, 1), Cells(1003, 13)).Copy
　　　　　　　　　　Workbooks(Databook).Activate
　　　　　　　　　　Workbooks(Databook).Sheets("Sheet" & j).Select
　　　　　　　　　　Cells(65536, 1).End(xlUp).Offset(1, 0).Select
　　　　　　　　　　ActiveCell.PasteSpecial
　　　　　　　　End If
　　　　　　Next
　　　　Workbooks(Mybook).Close False
　　End If
i = i + 1
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub FileListing()
Dim ws As Worksheet
filepath = "D:\work"

Sheets("Sheet5").Select
With Application.FileSearch
　　.NewSearch
　　.LookIn = filepath
　　.Filename = "*.*"
　　.SearchSubFolders = True
　　If .Execute() = 0 Then
　　　　End
　　Else
　　　　For 検索結果 = 1 To .FoundFiles.Count
　　　　　　Cells(検索結果, 1) = .FoundFiles(検索結果)
　　　　　　i = Len(filepath)
　　　　　　Cells(検索結果, 1) = Mid(Cells(検索結果, 1), i + 2, 200)
　　　　Next
　　End If
End With
End Sub

補足

ありがとうございます！ほんとにありがとうございます。試みてたのですが、「インデックスが有効範囲にありません」と表示され、「Workbooks(Mybook).Sheets("Sheet" & j).Select」の部分が黄色くなります。"Sheet"の部分の表記を変えたりしたのですが、状態が変わりません。各Sheetに名前をつけていることが原因でしょうか？知識不足に加え、不慣れなもので本当にすみません。自分なりにも頑張って解決を試みてみます。

回答No.5

n-jun

>シート４：13列(A-M)1003行、利用（合成）したいデータは、A4:M1003
>エクセルファイルが100個ほどあります。
約1000行を100ファイルから読み込むと言うのなら、
Excelのバージョンは2007でしょうか？

補足

Excelのバージョンは2003でも2007でもどちらでも使うことができます。

回答No.4

imogasi

大げさに難しい言葉で「データ合成」なんていうから、何かと思っちゃう。そんなエクセルの「用語」は無いですよ。
これは理論的には手作業でやれるが、手間がかかったり、根気が続かないだけ。こういうパターンの課題は、コンピュタにやらせる、すなわちVBAでやらすより他にない。１００ブックもエクセルで扱おうとするのは、VBAでもやれないと、運用できないと思う。
１つ２つのシートを人手作業して、マクロの記録をとり、連続して、人の目と手が無くてもできるようにするには、コードのどこをどう変えたら良いのか、まず文章で書き出してみて、各々が１つの課題になるだろうから、それを本やWEBや質問で１つ１つつぶしていくことです。
できない点も明確になってない丸投げなぞ、回答者に甘えすぎ。

お礼

ご指摘頂いた通りです。本来なら1つ1つ克服していくべきなのですが、時間がなかったためアドバイスを頂戴できればと思い、質問させていただきました。すみません。できる限りがんばってみます。

回答No.3

CaveatEmptor

合成というのは各ファイルのShee1のデータを追記するだけでいいのでしょうか？No1のファイルのSheet1のデータの下にNo2のSheet1のデータを書き足していくと理解したらいいですか？

ファイル名はどうなっているのでしょう？規則的なファイル名なのでしょうか？それとシートにどのようにデータが入力されているか（何列で何行なのか、どのセルに入力されているかなどです）がわからなければ、ＶＢＡでする方法を示すことができません。できれば補足をお願いします。

補足

合成というのは各ファイルのShee1のデータを追記するだけでいいのでしょうか？No1のファイルのSheet1のデータの下にNo2のSheet1のデータを書き足していくと理解したらいいですか？
→大体その通りです。シート１に関してはNo1のファイルのSheet1のデータの横にNo2のSheet1のデータを書き足していければベストです。勝手な願望でしかありませんが。説明不足で申し訳ありません。

ファイル名は2007○○××といった具合に規則的です。「○○」の部分は完全に同じ名称で、「××」の部分はファイルによって異なります。
各シートのデータは以下の通りです。
シート１：4列(A-D)42行、利用（合成）したいデータは、D4:D42
シート２：19列(A-S)161行、利用（合成）したいデータは、E3とB8:S10
シート３：35列(A-AI)303行、利用（合成）したいデータは、A4:AI303
シート４：13列(A-M)1003行、利用（合成）したいデータは、A4:M1003

ややこしい表記の仕方ですみません。
ファイルごとに記入されているデータの量は異なりますので、おおよそです。データは数値及びテキストが混ざってます。
VBAの使い方がよく分からず、困惑してます。どのようにすればいいか検討がつかず、悩んでいます。
アドバイス頂ければ幸いです。
よろしくお願いします。

回答No.2

TTak

データの同一フィールドにおいて、一方のデータを他方のデータの下に結合するような方法であれば、シート毎、ファイル毎ともにVBAでできます。

簡単な方法とのことですが、この手の処理はマクロの記録だけではできません。ただ、無料ではできます。

お礼

ありがとうございます。一度試してみます。

回答No.1

n-jun

合成とは、
・数値データの集計を行なう事？
・単にデータを下に追加して行く事？

＞できれば無料でできる方法を教えて頂ければ幸いです。
ＶＢＡを勉強して自作する。

補足

回答ありがとうございます。
データ合成は、単にデータを下に追加して行く事です。
VBAの勉強を試みているのですが、なかなか理解できなくて。すみません。