グループ合計 転記 excel2007 VBA

質問

Sheet1に月毎のの売上一覧があります。
Sheet2にSheet1の顧客別に合計したものを指定の位置へ転記したいのですが、
月によって売上セル領域が変動するため、いい方法がわかりません。
よろしくおねがいします。

Sheet1
　　　Ａ 　　　Ｂ 　　　C 　　　D
1 　　　日付 　　顧客 　　商品 　　　売上
2 　　2月1日 　　　あ 　コーヒー 　100
3 　　2月5日 　　　え 　　卵 　　　200
4 　　2月6日 　　　い　 パン 　　　300
5 　　2月10日 　　　い 　リンゴ 　　　100
6 　　2月18日 　　　あ 　　バナナ 　200
7 　　2月20日 　　　え 　　みかん 　100
8
9

Sheet2
Ａ 　　Ｂ
1 顧客 　売上合計
2 あ
3 い
4 う
5 え
6 お
7 か
8 き
9

回答No.2

chie65536（@chie65535） · ベストアンサー

Sheet2のB2に
=SUMIF(Sheet1!B:B,A2,Sheet1!D:D)
って書いて、下にコピー。

お礼

ありがとうございます。
出来ました！

回答No.4

Prome_Lin

回答No.3です。

注意事項を追加します。

上書き保存をしてしまいますので、試される場合は、コピーなど、元のファイルが必ず残る形でお願いします。

ちなみに、「コピー」は、ファイルやフォルダを表示するエクスプローラーで、目的のファイルをクリックして、右クリックから「コピー」を選びます。

適当なフォルダを作成し、そのフォルダの中に入り、やはり右クリックから「貼り付け」を選べば、元のファイルは、元のところに残ったまま、同じファイルがそのフォルダの中にコピーされます。

そのフォルダの中に、「～.vbs」ファイルを放り込んで、ダブルクリックしてください。

回答No.3

Prome_Lin

以下のプログラム（VBScript）を、テキストエディかメモ帳などにコピー＆ペーストして貼り付けます。

次に、目的のファイルを適当なフォルダに入れます。

そのフォルダには、他のエクセルファイルが入っていてはいけません。

エクセル以外でしたら構いませんが、エクセルファイルがあると、実行して、上書き保存してしまったり、エラーが出たりします。

最初の、エディタかメモ帳に貼り付けたプログラムを、名前を付けて保存で、今、目的のエクセルのファイルを入れた、同じフォルダに「～.vbs」（「～」の部分は適当に付けてください）という名前で、保存してください。

必ず、「.vbs」（カンマvbs）としてください。

「～.vbs」ファイルをダブルクリックすると、割とすぐに「Finished!」と表示すると思いますので、「OK」をクリック。

ファイルを見てみてください。

結果が出ていると思います。

これで、毎月、「～.vbs」ファイルを結果を出したいエクセルファイルのあるフォルダに放り込んで、ダブルクリックするだけです。

Option Explicit
Dim a, b, c, d, i, t, u, v, w, x, y, z
Set t = CreateObject("Scripting.FileSystemObject")
Set u = t.GetFolder(".")
Set v = CreateObject("Excel.Application")
v.Application.DisplayAlerts = False
v.Visible = False
For Each a In u.Files
b = t.GetExtensionName(a.Name)
If b = "xls" or b = "xlsx" Then
Set w = v.Workbooks.Open(u & "\" & a.Name)
Set x = w.Worksheets(1)
Set y = w.Worksheets(2)
For i = 2 to y.Range("A1").End(-4121).Row
y.Cells(i, 2).Value = 0
Next
For i = 2 to x.Range("B1").End(-4121).Row
c = x.Cells(i, 2).Value
Set z = y.Range("A:A").Find(c)
y.Cells(z.Row, 2).Value = y.Cells(z.Row, 2).Value + x.Cells(i, 4).Value
Set z = Nothing
Next
w.Save
w.Close
Set y = Nothing
Set x = Nothing
Set w = Nothing
End If
Next
v.Quit
Set v = Nothing
Set u = Nothing
Set t = Nothing
MsgBox("Finished!")

お礼

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

回答No.1

ushi2015

こんにちは
Sheet1に年月を表示する列を追加して、Sheet2にピボットテーブルで
集計するのはどうですか？

お礼

難しそうです…