『別シートへの振り分け』（SISIMARU） いつも勉強させてもらってます。 質問ですが、下記のような入力シートに入力すると、別シート（sheet2以降）にどんどん振り分けするようなことは、エクセルでは可能でしょうか？ どうぞどなたか教えて頂けませんでしょうか。よろしくお願いしますｍ（＿＿）ｍ ｛SHEET1（入力シート）｝ 　　Ａ　　Ｂ　　　　　　Ｃ　 １　番号　日付（曜日）　商品名　 ２　　1　　9/28（金）　　みかん ３　　2　　9/26（水）　　いちご ４　　3　　9/26（水）　　りんご ５　　4　　9/29（土）　　ぶどう　　 ６　　5　　9/28（金）　　いちご ７　　6　　9/29（土）　　みかん ・　　　　　・ ・　　　　　・ ・　　　　　・ ｛SHHET2（水曜日）｝ 　　Ａ　　Ｂ　　　　　　Ｃ　 １　番号　日付（曜日）　商品名　 ２　　2　　9/26（水）　　いちご ３　　3　　9/26（水）　　りんご ｛SHHET3（金曜日）｝ 　　Ａ　　Ｂ　　　　　　Ｃ　 １　番号　日付（曜日）　商品名　 ２　　1　　9/28（金）　　みかん ３　　5　　9/28（金）　　いちご ｛SHHET4（土曜日）｝ 　　Ａ　　Ｂ　　　　　　Ｃ　 １　番号　日付（曜日）　商品名　 ２　　4　　9/29（土）　　ぶどう ３　　6　　9/29（土）　　みかん ---- >入力シートに入力すると、別シート（sheet2以降）にどんどん振り分けするようなことは、 >エクセルでは可能でしょうか？ 入力シートに入力されたデータを訂正・削除・追加した場合には、どのような処理を？ ”どんどん”と言う点を具体的にされては？ (元夏バテ） ---- 曜日ごとに振り分けたいと言うことですね。 sheet1（入力シート）のB列の日付の入力は、シリアル値ですか？文字列ですか？ (SHIOJII） ---- 返信ありがとうございます。 sheet1（入力シート）のB列の日付の入力は、シリアル値です。 もし、文字列の方が作りやすければ、文字列に変更しようと思います。 また、訂正・削除・追加の場合も、別シートに反映されるようにしたいのです。 よろしくお願いします。 （SISIMARU） ---- >また、訂正・削除・追加の場合も、別シートに反映されるようにしたいのです。 このタイミングも、 >入力シートに入力すると、別シート（sheet2以降）にどんどん振り分けするようなことは、 これなのでしょうか？ データの入力完了後（訂正・削除・追加等々含む）に実行するのか？、上記タイミングで実行するのかで 変わってくるかと思いますけど。 （元夏バテ） ---- いろいろ条件がありますが ピボットテーブルを使ってみるのはどうでしょう。 http://www.excel.studio-kazu.jp/lib/e2d/e2d.html 「確認だけなら、一つのシートでいいでしょ？」 と言うスタンスですので、表示用のシートを 1枚作り、そこへSheet1の内容を　曜日を切り換えて表示します。 D列に作業列を作り、曜日をテキストで表示させます。 D1に見出しとして、「曜日」と入力 D2 =TEXT(B2,"aaa") として、下にコピー。 ピボットテーブルを作成する際、範囲は列で指定し 新しいワークシートへ作成して下さい。 ページのフィールド　に「曜日」 行のフィールドに「番号」「日付」「商品名」 データアイテムに　任意の一つ（どれでも良いです） をドラッグします。 それぞれ合計行が表示されるので右クリックで 非表示として下さい。 （空白）も非表示。 D列にデータアイテムに入れたアイテムでの集計結果が 表示されていると思いますが、これは必要ないので 列を選択して、非表示にして下さい。 ページのフィールドで表示したい曜日を選ぶと その曜日だけの情報が表示されます。 Sheet1の内容を変更した場合は[！]を押して データの更新を行って下さい。 どうしても７枚に分けたいんだ！！ って場合は、７枚分つくっても良いですが ７枚分データの更新をする必要がありますので その点はご理解下さい。 (HANA) ---- 数式で作成してみました。 Sheet2（水曜日） A B C D 1 番号 水曜日 商品名 2 2 9月26日(水) いちご 3 3 9月26日(水) りんご 3 4 4 B1セルには 4 と入力してユーザー定義　aaaa とします。 D2=IF(WEEKDAY(Sheet1!B2)=$B$1,ROW(),"") 必要分、下へフィルコピーしておきます。 A2=IF(COUNT($D$2:$D$100) 1 Then Exit Sub MyA = Range("A1:C" & Range("B" & Rows.Count).End(xlUp).Row) ReDim MyAry(1 To UBound(MyA, 1), 1 To 3) If UBound(MyB, 1) < Target.Row Or Target.Column <> 2 Then If Len(Range("B" & Target.Row)) = 0 Then Exit Sub MyWek = Format(MyA(Target.Row, 2), "aaaa") MyStr = MyA(Target.Row, 2) Else MyWek = Format(MyB(Target.Row, 2), "aaaa") MyStr = MyB(Target.Row, 2) End If With CreateObject("VBScript.RegEXP") .Pattern = "^(\d{2,4})/(\d{1,2})/(\d{1,2})$" If Not .Test(MyStr) Then Exit Sub If Not IsDate(Right$("20" & .Replace(MyStr, "$1"), 4) & "/" & .Replace(MyStr, "$2") & "/" & .Replace(MyStr, "$3")) Then _ Exit Sub End With MyAry(1, 1) = "番号" MyAry(1, 2) = "日付（曜日）" MyAry(1, 3) = "商品名" n = 1 For i = 2 To UBound(MyA, 1) If MyWek = Format(MyA(i, 2), "aaaa") Then n = n + 1 MyAry(n, 1) = MyA(i, 1) MyAry(n, 2) = Format(MyA(i, 2), "m/d (aaa)") MyAry(n, 3) = MyA(i, 3) End If Next i With Worksheets(MyWek) .Cells.ClearContents .Range("A1").Resize(UBound(MyAry, 1), 3) = MyAry() End With End Sub 　 シート構成は 「入力シート」 「月曜日」 「火曜日」 「水曜日」 「木曜日」 「金曜日」 「土曜日」 「日曜日」 の内容で作成済みとしています。 　 （キリキ）（〃⌒o⌒)b もうご覧になってないかもしれませんが、、、 少し、修正してみました。10/2 0:15 再度修正　10/2 1:17 ---- 皆様、返信頂き本当にありがとうございます。 HANAさんへ。ピボットテーブルを使った方法ですが、教えていただいて いるとおり、データの更新で少し手間を感じますので、その都度、データを 更新（反映）したいと思っています。 gon-2さん、配列数式ですよね。。式が理解できなくて。。でも、そのまんま やってみるとできました！！すごいです！！感動しました！ キリキさん、ＶＢＡやってみましたが、インデックスが有効範囲にありません ｛MyWek = Format(MyB(Target.Row, 2), "aaaa")　｝となってしまいました。 正直、中身が解読できません。 もう少し勉強してみますが、ＶＢＡは本当に苦手です。難しい（××） いずれにせよ、データを自動でふりわけて、ふりわけたデータが ふりわけ先で足されていくー（言葉が変ですが）という作業は、 データベースソフト（アクセスみたいな）ものでないとできないと思い込んでいました。 エクセルの奥の深さに改めて感動しました！ またよろしくお願いします。（SISIMARU） ---- キリキさん、ありがとうございます。 書き込んでしばらくしたら、上にあがっているので、驚きました！ で、修正して頂いたものを早速検証してみたら、いや、ほんとスゴイですね。 またまた感動しました！ 商品名のところが転記されてこない場合があるのですが、それ以外は完璧です。 商品名について、各曜日で２品目〜が入力されると、その前の商品が表示されます。 （例えば月曜日にNo.1とNo.5とNo.9が入ってくると、No.1とNo.5の商品名は 　表示されますが、No.9に関しては番号と日付のみ表示されます） もし分かれば又、教えてください。（SISIMARU） ---- >商品名のところが転記されてこない場合があるのですが、それ以外は完璧です。 そうですか＾＾； 　 一応、日付を入力したタイミングで転記してますので、商品名が入った状態で日付を入れたタイミングで 動くように考えてました。 　 一応、再度修正しましたので、時間があるときに試してみてください＾＾ （キリキ）（〃⌒o⌒)b ---- 下から失礼します〜。 これはそのシートを開いた時に最新のデータを転送します。 再修正はしとりまへんので、時間のあるときに試してみてください＾＾ 　　　（弥太郎））（〃⌒o⌒)b あ、これはThisWorkbookにコピペです。 '------------ Option Explicit Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim i As Long, j As Long, tbl, x, ary ary = Array("月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日", "日曜日") If IsError(Application.Match(Sh.Name, ary, 0)) Then Exit Sub ReDim x(1 To Rows.Count, 1 To 3) With Sheets("sheet1") tbl = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, 3) For i = 1 To UBound(tbl, 1) If Format(tbl(i, 2), "aaaa") = Sh.Name Then j = j + 1 x(j, 1) = tbl(i, 1) x(j, 2) = tbl(i, 2) x(j, 3) = tbl(i, 3) End If Next i End With Cells.ClearContents Range("a1").Resize(, 3) = Array("番号", "日付（曜日）", "商品名") If j Then Range("a2").Resize(j, 3) = x Range("b:b").NumberFormat = "m/d(aaa)" End If End Sub ---- ちぇっく、ちぇっく〜 　 >また、訂正・削除・追加の場合も、別シートに反映されるようにしたいのです。 こんなこといってまっせｗ ししょ〜のんは、日付を消したときに反映はしまへんなｗ 　 な〜んてｂ こんな方法は、思いつかなかった。。。 勉強になりました＾＾ 　 （キリキ）（〃⌒o⌒)b ---- え〜〜〜？ 日付を消すとはSheet1の日付の事でっしゃろ？（ネ、SISIMARUはん） 従ってその行は転送不要のデータに（曜日を検索しての条件）なりますから 当然転送データに含まれまへんのんではないんではないんでせうか？（笑 つまり、そのシートがアクチブになったらシート１の全ての情報を当該シートに転送 すればえぇんではないのではないのでせうか？ 　　　　ガハハ、ヒックの（弥太郎） ---- >日付を消すとはSheet1の日付の事でっしゃろ？（ネ、SISIMARUはん） はい。そう思っとります。 　 Sheet1 の、日付を削除。（仮に 月曜日） その曜日が1個しかなかったとします。 それを消しちゃったら。。。 　 今日は休みで、もう呑んでる（キリキ）（〃⌒o⌒)b ---- あ、これは正しくイチャモンや＾＾ 当方２００００データでこのイベントが耐えるに値する処理時間かどうかを念頭にお いておりましたもんで、データが無いなんぞは考えてもおりまへんでしたワ。 しゅうせぇしときましたんで、イチャモンつけてみなはれ＾＾ 　　（弥太郎）（〃⌒o⌒)b 　　　　　　　　　　↑　の顔につばすると、（〃⌒o⌒)b　にかかる、ヒヒヒ ---- バッチリですｂ 　 >しゅうせぇしときましたんで、イチャモンつけてみなはれ＾＾ つけたくても、ありまへん！ 　 つばはかけんとってくださいｗ （キリキ）（〃⌒o⌒)b