エクセルのフィルターマクロのやり方

質問

毎月定例の作業があり、その量も膨大なのでマクロ等を使用してエクセルファイルを作りたいと思っています。そこで、教えてください。

定例作業は下記のイメージ。図－1をフィルターかけて分解して新しいシート（【図－１】【図－２】）を作り、合計金額を出していきます。
【図－１】
　　　　　A　　　　　　　　　B　　　　　　　　C　　　　　　　　　　D
平成25年4月5日　　　営業費　　　　　リンゴ　　　　　　　　500円
平成25年4月6日　　　営業費　　　　　みかん　　　　　　　1000円
平成25年4月6日　　　営業費　　　　　ライチ　　　　　　　　400円
平成25年4月7日　　　備消費　　　　　ライター　　　　　　 500円
平成25年4月8日　　　建設費　　　いろは工務店　　　　1000000円
　　　　　：　　　　　　　　　：　　　　　　　　　：　　　　　　　　　　：
　　　　　：　　　　　　　　　：　　　　　　　　　：　　　　　　　　　　：
【図－２】
　　　　　A　　　　　　　　　B　　　　　　　　C　　　　　　　　　　D
平成25年4月5日　　　営業費　　　　　リンゴ　　　　　　　　500円
平成25年4月6日　　　営業費　　　　　みかん　　　　　　　1000円
平成25年4月6日　　　営業費　　　　　ライチ　　　　　　　　400円

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　合計　1900円
【図－３】
　　　　　A　　　　　　　　　B　　　　　　　　C　　　　　　　　　　D
平成25年4月5日　　　建設費　　　いろは事務所　　　　100000円
平成25年4月8日　　　建設費　　　いろは工務店　　　　1000000円

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　合計　　1100000円

上記の図でお分かりになれましたでしょうか？補足説明をすると、最初にフィルターをかけて科目ごとに別シートに貼り付け。シート（同じ科目）の合計金額を出す。っといった感じです。

皆様のお力を貸してください。

回答No.2

KURUMITO · ベストアンサー

マクロを使って処理するよりもデータがシート1に追加されれば即座に他のシートのデータも最新のものに自動的に変更される、また、データが多くなっても処理速度も速いなど関数を使って処理することがよいでしょう。
シート1は元のデータで2行目から下方にデータが入力されているとしてＥ2セルには次の式を入力して下方にドラッグコピーします。

=IF(B2="","",B2&COUNTIF(B$2:B2,B2))

結果を他のシートに表示させるわけですが該当するシート名をＣｔｒｌキーを押しながらシート見出しでクリックします。
それらのシートが作業グループとなります。
そこでＡ1セルには例えば営業費と入力します。
Ｂ1セルには合計額とでも入力し、Ｃ1セルには次の式を入力します。

=SUMIF(Sheet1!$B:$B,$A$1,Sheet1!$D:$D)

Ａ2セルからＤ2セルにはシート1と同じ項目名を入力します。
Ａ3セルには次の式を入力してＤ3セルまで横にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ROW(A1)>COUNTIF(Sheet1!$B:$B,$A$1),"",INDEX(Sheet1!$A:$D,MATCH($A$1&ROW(A1),Sheet1!$E:$E,0),COLUMN(A1)))

Ａ列を選択して右クリックして「セルの書式設定」の「表示形式」の日付の中から好みの表示を選択してＯＫします。
最後にシート見出しで右クリックして「作業グループの解除」を選択します。
他のシートでＡ1セルに例えば建設費と入力することで表が書き換えられます。

お礼

ありがとうございます！関数でしたら、メンテナンスや後任への引き継ぎに良いですね。参考になりました!!!!!

回答No.1

tom04

こんにちは！
「図‐1」はSheet1にあり、↓の画像のような配置になっているとします。
そしてSheet2以降のSheet名は「営業費」等々各「費目」のSheet名のSheetが存在しているとしての一例です。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1() 'この行から
Dim i As Long, k As Long, str As String, wS As Worksheet
For k = 2 To Worksheets.Count
str = Worksheets(k).Name
Set wS = Worksheets(str)
wS.Cells.ClearContents
With Worksheets("Sheet1")
.Cells(1, 1).AutoFilter field:=2, Criteria1:=str
.Cells(1, 1).CurrentRegion.Copy wS.Cells(1, 1)
End With
i = wS.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
With wS.Cells(i + 1, 3)
.Value = "合計"
.Offset(, 1) = WorksheetFunction.Sum(Range(wS.Cells(2, 4), wS.Cells(i, 4)))
End With
End If
Next k
With Worksheets("Sheet1")
.Activate
.AutoFilterMode = False
End With
End Sub 'この行まで

こんな感じではどうでしょうか？m（_ _）m

お礼

私が担当の時はVBEをつかいます(o^^o)後任への引き継ぎとメンテナンスを考えると難しいかな！っでもすっごいいいのが出来ました!!!!!ありがとうございます(＾ー^)ノ