Excel 蓄積された売上データを別シートに書き出す方法を教えて下さい

質問

Excel2002を使った、下記のようなファイルがあります。
Ａ列　　　　Ｂ列　　　Ｃ列　　　　　Ｄ列　　　　　Ｅ列
製品コード　製品名　売上数量　　売上金額　　売上年月日
12345　　　　Ａ　　　　2　　　　　　1000　　　　　20001213

過去5年間の全製品の売上データが上記のような形式で1つのシートに蓄積されています。（売上年月日の昇順でソートされています）
このデータを、売上年月ごとに別シートに分けていきたいのですが、何かいい方法はありますでしょうか？
最初はオートフィルタで抽出して1つづつ別シートに移していこうかと思ったのですが、結構なデータ量でしたので、質問させて頂きました。
よろしくお願いします。<m(__)m>

回答No.6

freednia · ベストアンサー

一応置いておきます。
元データはシート1枚だけにしておいてください。
シート名はなんでもいいです。
データの並びもバラバラでも構いません。
作成するシートの最初の月と最後の月を変えて使ってください。

Sub Macro()

Dim i
Dim month As Variant
Dim mon_str As String
i = 2
month = DateSerial(2000, 12, 1) '←ここにこの形式で最初の月を入れる
mon_str = Format(month, "yyyymm")

Do
Sheets(1).Select
Sheets.Add
Sheets(1).Cells(1, 1) = Sheets(2).Cells(1, 1)
Sheets(1).Cells(1, 2) = Sheets(2).Cells(1, 2)
Sheets(1).Cells(1, 3) = Sheets(2).Cells(1, 3)
Sheets(1).Cells(1, 4) = Sheets(2).Cells(1, 4)
Sheets(1).Cells(1, 5) = Sheets(2).Cells(1, 5)
Sheets(1).Name = mon_str
Sheets(1).Move After:=Sheets(i)
i = i + 1
month = DateAdd("m", 1, month)
mon_str = Format(month, "yyyymm")
Loop Until mon_str = "200501" '←ここにこの形式で最後の月の次の月を入れる

Sheets(1).Select

Dim x, y
x = 2
Do
mon_str = CStr(Cells(x, 5))
month = DateSerial(Val(Left(mon_str, 4)), Val(Mid(mon_str, 5, 2)), Val(Right(mon_str, 2)))
mon_str = Format(month, "yyyymm")
y = 1
Do
y = y + 1
Loop Until Sheets(mon_str).Cells(y, 1) = ""
Sheets(mon_str).Cells(y, 1) = Sheets(1).Cells(x, 1)
Sheets(mon_str).Cells(y, 2) = Sheets(1).Cells(x, 2)
Sheets(mon_str).Cells(y, 3) = Sheets(1).Cells(x, 3)
Sheets(mon_str).Cells(y, 4) = Sheets(1).Cells(x, 4)
Sheets(mon_str).Cells(y, 5) = Sheets(1).Cells(x, 5)
x = x + 1
Loop Until Cells(x, 1) = ""

End Sub

お礼

freedniaさま、
お忙しい中、ありがとうございました！難なく、ファイルが完成しました！ヾ(〃^∇^)ノ♪
これを手作業でやってたら、かなりの時間を費やしていた事と思います。
また、今後、別ファイルででも使わせて頂こうと思っています。本当にありがとうございました。<(_ _)>

P.S.お礼が遅くなり、申し訳ございませんでした。会社からはログインできなかったもので...

回答No.5

freednia

たびたび申し訳ないです。
#3のコードでシートも自動追加してます。
ちゃんと読んでませんでした・・・お恥ずかしい・・・

それでは頑張ってくださいね！

回答No.4

freednia

すいません。
昨日時間がなくて途中までしか出来てません。
#3さんが書いてくれてるので大丈夫そうですね。
ただ60シートも手作業で追加して名前つけていくのは大変な手間だと思います。
私の書いたコードでは自動でシートも作成するので、参考にしてみてください。

って言っても今手元にコードがないので記載できないです・・・
12時に会社に行くのでそれまで待っていたら記載します（笑

回答No.3

imogasi

ＶＢＡしかないようですね。それで考えてみました。
（１）Ｓｈｅｅｔ１のＥ列に日付があって、その昇順にソート済みとする。
（２）各月分を「200401」や「200401」・・・のように６０シートばかり増やしていきます。余分なシートは別ブックにしておいてください。
（３）Set sh1 = Worksheets("sheet1")の（）内は質問者の場合のシート名を入れてください。
（ＶＢＡ）
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
'----初期設定
y = Year(sh1.Cells(2, "E"))
m = Format(Month(sh1.Cells(2, "E")), "00")
km = y & m
MsgBox km
Set sh2 = Worksheets.Add
sh2.Name = km
j = 2
'----
For i = 2 To 60
'----
y = Year(sh1.Cells(i, "E"))
m = Format(Month(sh1.Cells(i, "E")), "00")
k = y & m
MsgBox k
'------
If k = km Then
sh2.Cells(j, "E") = sh1.Cells(i, "E")
sh2.Cells(j, "A") = sh1.Cells(i, "A")
sh2.Cells(j, "B") = sh1.Cells(i, "B")
sh2.Cells(j, "C") = sh1.Cells(i, "C")
sh2.Cells(j, "D") = sh1.Cells(i, "D")
j = j + 1
Else
Set sh2 = Nothing
Set sh2 = Worksheets.Add
sh2.Name = k
j = 2
sh2.Cells(j, "E") = sh1.Cells(i, "E")
sh2.Cells(j, "A") = sh1.Cells(i, "A")
sh2.Cells(j, "B") = sh1.Cells(i, "B")
sh2.Cells(j, "C") = sh1.Cells(i, "C")
sh2.Cells(j, "D") = sh1.Cells(i, "D")
j = j + 1
km = k
End If
Next i
End Sub
少数データでテスト済み。しかし1年ぐらい出でまず中断して内容をチェックしてください。
最終（本番で）はMsgBox kを削除してください。
テストで出来たシートはＳＨＩＦＴキーを押しながら、シートタブをクリックしていって、削除すれば一遍に消せます。

お礼

imogasi様、
ありがとうございます！（感涙！）
今は手元に本番データがないので、明日試してみます。
結果は、またご報告させて頂きます。
本当にありがとうございました。<(_ _)>

回答No.2

freednia

#1さんの言うとおりDBのほうがいいかもしれないですね。

そうも言ってられないので、とりあえずはExcelでの対処しないとならんのですよね？
12×5=60ヶ月もあるとフィルタではかなり面倒ですね。
マクロを使うほうが楽かもしれないですが、慣れていなければ地道な作業のほうが早いかも？
マクロを使えるならコードの案を出させて頂きます。

お礼

freednia様、
早速のご回答、ありがとうございます。
そうなんです、そうも言っていられず、とりあえずExcelで何とかしなければならいんです...(T_T)
マクロコードの案、教えて頂けるのなら、是非×2お願いしたいです！
お手数おかけしますが、よろしくお願い致します。m(__)m

回答No.1

mrayu_2001

Excelのフィルター機能で「フィルターオプションの設定」で抽出して別シートにCOPYしていく手はありますが、データ量も多くなったことですので、そろそろEXCELは卒業して、ACCESS等のRDBへシステムを移行してはどうでしょうか？

お礼

mrayu_2001様、
早速のご回答、ありがとうございます。
やはりそうですよね...Excelでは無理がありますよね...。
でも今回は、Accessを使えない人にも見てもらうために、Excelで処理しなければならないのです...（_ _。）・・・シュン
でもこれだけデータが多くなると、はやり移行を考えるべきですね。ご意見、ありがとうございました。m(__)m