Excel2002を使った、下記のようなファイルがあります。
A列 B列 C列 D列 E列
製品コード 製品名 売上数量 売上金額 売上年月日
12345 A 2 1000 20001213
過去5年間の全製品の売上データが上記のような形式で1つのシートに蓄積されています。(売上年月日の昇順でソートされています)
このデータを、売上年月ごとに別シートに分けていきたいのですが、何かいい方法はありますでしょうか?
最初はオートフィルタで抽出して1つづつ別シートに移していこうかと思ったのですが、結構なデータ量でしたので、質問させて頂きました。
よろしくお願いします。<m(__)m>
No.6ベストアンサー
- 回答日時:
一応置いておきます。
元データはシート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.4
- 回答日時:
すいません。
昨日時間がなくて途中までしか出来てません。
#3さんが書いてくれてるので大丈夫そうですね。
ただ60シートも手作業で追加して名前つけていくのは大変な手間だと思います。
私の書いたコードでは自動でシートも作成するので、参考にしてみてください。
って言っても今手元にコードがないので記載できないです・・・
12時に会社に行くのでそれまで待っていたら記載します(笑
No.3
- 回答日時:
VBAしかないようですね。
それで考えてみました。(1)Sheet1のE列に日付があって、その昇順にソート済みとする。
(2)各月分を「200401」や「200401」・・・のように60シートばかり増やしていきます。余分なシートは別ブックにしておいてください。
(3)Set sh1 = Worksheets("sheet1")の()内は質問者の場合のシート名を入れてください。
(VBA)
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を削除してください。
テストで出来たシートはSHIFTキーを押しながら、シートタブをクリックしていって、削除すれば一遍に消せます。
imogasi様、
ありがとうございます!(感涙!)
今は手元に本番データがないので、明日試してみます。
結果は、またご報告させて頂きます。
本当にありがとうございました。<(_ _)>
No.2
- 回答日時:
#1さんの言うとおりDBのほうがいいかもしれないですね。
そうも言ってられないので、とりあえずはExcelでの対処しないとならんのですよね?
12×5=60ヶ月もあるとフィルタではかなり面倒ですね。
マクロを使うほうが楽かもしれないですが、慣れていなければ地道な作業のほうが早いかも?
マクロを使えるならコードの案を出させて頂きます。
freednia様、
早速のご回答、ありがとうございます。
そうなんです、そうも言っていられず、とりあえずExcelで何とかしなければならいんです...(T_T)
マクロコードの案、教えて頂けるのなら、是非×2お願いしたいです!
お手数おかけしますが、よろしくお願い致します。m(__)m
No.1
- 回答日時:
Excelのフィルター機能で「フィルターオプションの設定」で抽出して別シートにCOPYしていく手はありますが、データ量も多くなった
ことですので、そろそろEXCELは卒業して、ACCESS等のRDBへシステムを移行してはどうでしょうか?mrayu_2001様、
早速のご回答、ありがとうございます。
やはりそうですよね...Excelでは無理がありますよね...。
でも今回は、Accessを使えない人にも見てもらうために、Excelで処理しなければならないのです...(_ _。)・・・シュン
でもこれだけデータが多くなると、はやり移行を考えるべきですね。ご意見、ありがとうございました。m(__)m
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAで最新のデータを別シートに転記する方法をお教えください。 3 2022/04/07 19:20
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Excel(エクセル) エクセルで年月ごとの売り上げを集計する方法を教えてください 7 2022/06/01 17:06
- Visual Basic(VBA) VBAで、1つのエクセルで、2つのシートからもう1つのシートに条件のある転記コードを教えてください。 1 2023/03/16 18:07
- Excel(エクセル) Excel 売上管理シートに入力した売上データを、日報に自動反映させたいと考えています。 売上管理シ 3 2023/04/29 18:08
- Excel(エクセル) マクロか関数で処理したいのですが、教えて頂けませんか。 8 2022/10/31 15:18
- その他(Microsoft Office) Excelで該当しない項目(#N/Aの商品名)を簡単に表示・抽出させる方法についてです 1 2022/08/25 22:12
- Excel(エクセル) Excelで日報を自動で作成したい 売上管理シートに入力した売上データを、日報に自動反映させたいと考 1 2023/04/29 18:07
- Visual Basic(VBA) VBAで、シート間の転記するコードをFOR~NEXTで教えてください。 9 2023/04/30 20:04
- Excel(エクセル) Excelの関数でこんな処理ができますか 1 2023/02/08 13:46
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
excelの差込印刷で可視セルだけ...
-
エクセルVBA 別シートの複数の...
-
シャープのアクオス sh-m25 を...
-
歯抜けの時間を埋めて行の挿入
-
VBA:同じ文字列データの比...
-
エクセルVBAで SendKeys "{TAB}"
-
VBAの処理が途中で止まる
-
エクセルVBAでの日付順のデ...
-
Excelマクロ データが上書きさ...
-
Excel VBA インデックスの境...
-
VBAで複数シート選択
-
excel:色付き文字の抽出と変換法
-
Excel VBA :2回目以降実行で貼...
-
Excel で行を指定回数だけコピ...
-
複数条件に一致したデータを月...
-
エコウォッシュシステムの値段...
-
EXCELマクロで全シート対...
-
ノートパソコン 2in1について i...
-
VBA 貼付先範囲(行)がいっぱ...
-
情報系の授業の課題なのですが...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBA 別シートの複数の...
-
Excel で行を指定回数だけコピ...
-
Excel VBA インデックスの境...
-
excelの差込印刷で可視セルだけ...
-
VBA:同じ文字列データの比...
-
VBA別シートの最終行の下行へ貼...
-
エクセル:VBAで月変わりで、自...
-
エクセルVBAで 2種のリストを...
-
歯抜けの時間を埋めて行の挿入
-
エクセルVBAで SendKeys "{TAB}"
-
VBAで条件が一致する行のデータ...
-
EXCELマクロで全シート対...
-
VBAの指示の内容 昨日こちらで...
-
Excel VBAでシート内全体に非表...
-
VBAで複数シート選択
-
Excelマクロ データが上書きさ...
-
Excel VBA 時刻でのD...
-
VBA 貼付先範囲(行)がいっぱ...
-
エクセルVBAでの日付順のデ...
-
【WORD差し込み印刷】複数レコ...
おすすめ情報