多数のエクセルファイルからデータ抽出するマクロ

一つのフォルダの中に
同じフォームのエクセルファイルが多数あり、
全エクセルファイル内のセルから値を抽出し、
別の新規エクセルファイルに次々と収集する方法はないでしょうか？

コピペだと大変な作業なのでマクロで出来ないかと考えてます。

抽出元ファイルで
申し込み番号とIDの位置はA2,G1と決まっているのですが
合計税込金額はB列ですが表示行は変動します。
またその金額はSUM関数で表示されています。

それらを抽出したの新規エクセルファイルには
マクロを実行した日付を自動で挿入されるようにしたいのですが
可能でしょうか？

完成イメージとして画像を添付しました。
どうかご教授頂けないでしょうか？

No.1 回答者： lv4u 回答日時： 2014/06/19 06:15

>>コピペだと大変な作業なのでマクロで出来ないかと考えてます。

エクセルのマクロは、VBA(Visual Basic for Applications)を使っています。マクロって、自分の行った作業を再現するだけの機能のように思えますけど、れっきとしたプログラム言語であるVisual Basicの命令を生成しているんです。
だから、生成されたVBAのプログラムを自分で追加・加工すれば、相当複雑なことであっても、可能になります。

以下にストーリ仕掛けでＶＢＡを学んでいくサイトがありますので、これを見て勉強すれば、いいかもしれません。
もちろんエクセルＶＢＡの書籍を買ったりするのもいいと思います。

http://vbae.odyssey-com.co.jp/column/index.html

この回答へのお礼

ありがとうございます。
この機会に勉強してみます。

お礼日時：2014/06/19 08:54

No.2 ベストアンサー 回答者： eden3616 回答日時： 2014/06/19 14:15

(1)「抽出先のブック」を選択して「Alt+F11」で「Microsoft Visual Basic」を開く

(2)「挿入→標準モジュール」でモジュールを新規作成
(3)以下の「VBAコード」を貼付
(4)右上の「×」で(1)を終了
(5)エクセルメニューの「表示→マクロ」から「取得」を選んで実行
(6)対象のフォルダを選択するダイアログが表示されるのでフォルダを指定


※税込価格の行を取得するために検索するキーワードについて

画像ですと「合計　税込価格」のスペースが全角・半角判断しにくいため現在半角で作成しています。
もし間違っているようであればコード内の以下の部分を適切に修正願います。
word = "合計 税込価格" '検索するキーワード


■VBAコード

Option Explicit

Sub 取得()
'型宣言
Dim buf As String
Dim cnt As Long
Dim dpath As String
Dim tbook As Workbook
Dim lbook As Object
Dim hit As Object
Dim word As String

'準備
Set lbook = ThisWorkbook.ActiveSheet
cnt = 2 '開始行の設定
word = "合計 税込価格" '検索するキーワード

'抽出先のリストを削除
lbook.Range(cnt & ":" & Rows.Count).ClearContents

'フォルダ選択ダイアログ
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
dpath = .SelectedItems(1) & "\"
End If
End With
If dpath = "" Then Exit Sub

'ファイル一覧の取得
buf = Dir(dpath & "*.*")

'ファイルの数だけループ
Do While buf <> ""
Set tbook = Workbooks.Open(Filename:=dpath & buf, ReadOnly:=True) 'ブックを開く
With tbook.ActiveSheet
lbook.Range("A" & cnt).Value = .Range("A2").Value '申し込み番号取得
lbook.Range("B" & cnt).Value = .Range("G1").Value 'ID取得
Set hit = .Cells.Find(word) 'キーワードを検索
If hit Is Nothing Then
lbook.Range("C" & cnt).Value = "不明" 'キーワードが見つからなかった場合「不明」を表示
Else
lbook.Range("C" & cnt).Value = .Range("B" & hit.Row).Value '合計価格の取得
End If
lbook.Range("D" & cnt).Value = Date '日付を取得
End With
tbook.Close 'ブックを閉じる
buf = Dir()
cnt = cnt + 1 'カウントアップ
Loop
End Sub

この回答へのお礼

ありがとうございます。
お教え頂いたとおり実行すれば思った通りの抽出が出来ました。
感謝致します。

このままで終わらせず
eden3616様に記載頂いたVBAコードがどのようにして機能しているのか
解読しながら自分でもVBAを勉強してみます。

お礼日時：2014/06/19 18:42