excel vbaでVlookup的な集計したい

質問

お世話になります。

デスクトップに[集計]というフォルダ作って、その中に[集計.xls]というファイルがあります(画像参照)
さらに[個別]というファイルダ内に[実績A.xls]というファイルがあります。
実際には実績B.xls、実績C.xlsと複数ファイルが存在します。

集計.xlsにボタンを作ってクリックすると下記のような動きを実現したいのです。

[個別]フォルダ内の実績A.xlsファイルを開いて[集計.xls]のA列(支店名)、B列(商品番号)と合致したデータを次のように挿入していきたいのです。

集計.xls 　実績A.xls
C列　　←　D列の値
D列　　←　E列の値
E列　　←　F列の値
F列　　←　G列の値

この作業を実績A.xlsファイルの全シートに対して実施したいのです。(マスターというシートは抜かして左から右へ)。全シートREADし終わったら閉じて次の実績B.xlsファイルを開いて、また同じ作業を繰り返し、[集計.xls]もA2のデータから再びREAD、という動きです。

わかりにくい説明で大変恐縮ですが、業務で求められ困っております・・
どなたかご教授いただけますでしょうか。

何卒よろしくお願い致します。

Excel2013
Windows7

回答No.2

Prome_Lin · ベストアンサー

この回答は、結果は出ると思うのですが（完全な形では確かめていないので）、ご要望の趣旨と異なるので、無視して頂いて結構です。

一応説明します。

以下のプログラムをテキストエディタにコピー＆ペーストし貼り付けます（メモ帳でも構いません）。

「～.vbs」という名前で保存するのですが、保存する場所は、「集計」と「個別」フォルダの上のフォルダです。

例えば「集計」フォルダと「個別」フォルダが「Ｄ」ドライブの「エクセル」フォルダの下にあるのでしたら、「エクセル」フォルダに保存します。

保存した「～.vbs」ファイルをダブルクリックする（シングルクリックしてEnterの方がより確実）と、集計を始めます。

今は、安全のため、「集計１.xlsx」という名前で保存し、元の「集計.xlsx」は、そのまま残っています。

処理が終了すると、「Finished!」と表示しますが、それまでの間、絶対にパソコンをいらってはいけません。

特に今回の処理に関係の無いファイルであっても、エクセルのファイルを開けたり、エクセルを起動しただけで、間違いなくエラー終了してしまいます。

もう一つ、注意事項としては、「個別」フォルダにある、エクセルファイルは、ファイル名に関係なく、すべて処理してしまいますので、関係の無いエクセルファイルは「個別」フォルダには入れないでください。

Option Explicit
Dim a, b, c, d, f, i, j, k, r, t, u, v, w, x, y, z
Set t = CreateObject("Scripting.FileSystemObject")
Set u = t.GetFolder(".")
Set f = t.GetFolder(u & "\個別")
Set v = CreateObject("Excel.Application")
v.Application.DisplayAlerts = False
Set w = v.Workbooks.Open(u & "\集計\集計.xlsx")
Set x = w.Worksheets(1)
r = x.Range("A1").End(-4121).Row
For Each a In f.Files
b = LCase(t.GetExtensionName(a.Name))
If b = "xls" or b = "xlsx" Then
Set y = v.Workbooks.Open(u & "\個別\" & a.Name)
For i = 1 to y.Worksheets.Count
Set z = y.Worksheets(i)
For j = 1 to z.Range("A1").End(-4121).Row
c = z.Cells(j, 1).Value
d = z.Cells(j, 2).Value
For k = 1 to r
If x.Cells(k, 1).Value = c and x.Cells(k, 2).Value = d Then
x.Cells(k, 3).Value = x.Cells(k, 3).Value + z.Cells(j, 4).Value
x.Cells(k, 4).Value = x.Cells(k, 4).Value + z.Cells(j, 5).Value
x.Cells(k, 5).Value = x.Cells(k, 5).Value + z.Cells(j, 6).Value
x.Cells(k, 6).Value = x.Cells(k, 6).Value + z.Cells(j, 7).Value
End If
Next
Next
Set z = Nothing
Next
y.Close
Set y = Nothing
End If
Next
w.SaveAs(u & "\集計\集計1.xlsx")
w.Close
v.Quit
Set x = Nothing
Set w = Nothing
Set v = Nothing
Set u = Nothing
Set t = Nothing
MsgBox("Finished!")

お礼

Prome_Linさん、先日ご教授いただきました方法で実現できました！
本当に!本当に!どうもありがとうございましたm(_ _)m
今回は私の分りずらい説明にも関わらず、ご丁寧なお返事いただきまして本当にありがとうございました！本当に助かりました。

補足

Prome_Linさん、こんな分りづらい質問にご丁寧なご回答いただきまして本当にありがとうございます！！

実際にまだ試させていただいてはおりませんが、ご説明を読ませていただく限りでは私が望む動きにかなり近い気がします！

後ほどご教授いただきましたロジックで試してみます！
ありがとうございました！

>「個別」フォルダにある、エクセルファイルは、ファイル名に関係なく、>すべて処理してしまいますので、関係の無いエクセルファイルは「個別」>フォルダには入れないでください。
→このような運用を考えていましたので、むしろそうしたかったのです！

回答No.1

kagakusuki

>わかりにくい説明で大変恐縮ですが、業務で求められ困っております・・

　解り難い説明ではなく、説明になっていないため、何をしたいのかがさっぱり解りません。

>[個別]フォルダ内の実績A.xlsファイルを開いて[集計.xls]のA列(支店名)、B列(商品番号)と合致したデータを次のように挿入していきたいのです。

との事ですが、コピー元のシートは

>この作業を実績A.xlsファイルの全シートに対して実施したいのです。

だとしましても、貼り付け先のシートはどのシートなのですか？
　実績A.xlsとその他の実績B.xls、実績C.xlsの中に同名のシート名が存在している場合には、実績A.xlsのデータをコピーした後で、実績B.xlsや実績C.xlsのデータを上書きする事で、実績A.xlsからコピーしたデータは消去してしまう様にすれば良いのですか？
　もし貼り付け先のシートが集計.xlsの中には存在しなかった場合にはどうすれば良いのですか？
　[個別]フォルダがメモリーの中のどこに存在しているのかを表すパスはどうなっているのですか？

お礼

kagakusuki さん、今回は皆様にお助けていただいたお陰で何とか実現できました。

本当に!本当に!どうもありがとうございましたm(_ _)m

補足

kagakusuki さん、早速のご連絡誠にありがとうございます！
私の文章は説明になっておりませんでした。
大変失礼いたしました。
ご指摘いただきました内容につきまして以下お返事させていただきます。

>だとしましても、貼り付け先のシートはどのシートなのですか？
→集計.xlsの[Sheet1]になります

＞実績A.xlsからコピーしたデータは消去してしまう様にすれば良いのですか？
→はい。それで結構です。(基本的に同名のシートは存在しません)
ただ実績A.xlsを見るときにシート名は検索キーとしてプログラムの中では意識せず、　検索キーとしては集計.xlsのA列の支店名と実績A.xlsのA列の支店名を検索キーとして使いたいのです。A列が合致したら次に集計.xlsのB列の商品番号と実績A.xlsのB列の品番(品番は重複存在しない)を見て合致したら、集計.xlsのC列に実績A.xlsのB列の値、集計.xlsのD列に実績A.xlsのE列の値、集計.xlsのE列に実績A.xlsのF列の値、集計.xlsのE列に実績A.xlsのF列の値が入るようにしたいです。値がなければ0で構いません。

>もし貼り付け先のシートが集計.xlsの中には存在しなかった場合にはどう>すれば良いのですか？
→例えば実績A.xlsの部署が集計.xlsに存在しなかった場合は何もせずそのまま閉じて実績A.xlsを閉じて次のファイル(例：実績B.xls)をOPEN→READしたいです。

>[個別]フォルダがメモリーの中のどこに存在しているのかを表すパスはど>うなっているのですか？
→各ファイルのパスは以下のようになります。
　■集計.xls
C:\Users\XXXXX\Desktop\集計

　■実績A.xls、実績B.xls、実績C.xls...
C:\Users\XXXXX\Desktop\集計\個別

以上です。

お手間をおかけしまして申し訳ございませんが、お力添えをいただけますと幸いでございます。