エクセルのあるシートの内容を条件毎に行単位で複数のシートに振り分けるには？ - Office系ソフト - 教えて！goo

一応スクリプトの方も見直していますが、確認させてください。

１）集計ページのA1セルに集計したい人物の名前は入っていますか？

２）「たろうが3行目-4行目に減り」のところで、データを削除するのに、行削除などしていませんか？

こちらで、不具合が再現できれば対策を講じることができると思うのですが、もう少し詳しく教えていただいてもよろしいですか？

通報する

すみません、スクリプトの方の記述ミスです。

Sub RenewAutoFilter()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Select
If ws.Cells(1, 1) <> "" Then
Selection.AutoFilter Field:=1, Criteria1:=ws.Cells(1, 1)
End If
Next ws

End Sub

お手数ですが、差し替えてください。

通報する

あと、マクロが気に食わない！という場合は、VisualBasicEditorを再び実行し、ペーストしたマクロを消去すれば、マクロはなくなります。

通報する

#5の補足です。

１．コードをペーストしたら、VisualBasicEditorは終了してください。Excelに戻ったら、保存をします。これでコードがワークシートに保存されます。（念のため別名保存しておくといいかもです）

２．以後は、起動のたびにマクロがウィルスの可能性があるよなどと聞かれるかもしれませんので、「マクロを有効にする」を選びます。これは、私のマクロがウィルスだったらどうするんだ？というExcelのありがたいお世話なので、気にしなくていいです。

３．原版を更新したら、Alt+F8で、Sheetx.RenewAutoFilter（私の組んだマクロの名前）を実行すれば自動的に全ページのオートフィルタをかけなおしてくれます。

シートのA1セルに文字列が入力されているとフィルタがかかってしまうので、空白にしてください。（行挿入などして）
あやまって、フィルタしてしまった場合は、あわてずさわがず、データ＞フィルタ＞レオートフィルタをクリックし、オートフィルタを解除すれば全表示に戻ります。

通報する

#4の件ですがすみません。フィルタが自動的に更新してくれると思ったのですが、どうもできないみたいですね。

お詫びといってはなんですが、汎用的なマクロを組んでみました。

Sub RenewAutoFilter()
For Each ws In ActiveWorkbook.Worksheets
ws.Select
If Cells(1, 1) <> "" Then
Selection.AutoFilter Field:=1, Criteria1:=Cells(1, 1)
End If
Next ws
End Sub

これを
ツール＞マクロ＞Visual Basic Editor
とし、
左の方にSheetがならんでいるところをどのシートでもいいのでダブルクリックしてみてください。
コードが入力できるようになりますので、上のマクロをペーストしてください。

以後、ツール＞マクロ＞マクロ（Alt+F8でも可能）で、Sheet1.RenewAutoFilterを実行すればマクロがスタートします。

使い方ですが、各ページ1行目を項目行としてあけておきます。（原版も）

マクロは各ページA1セルを参照してそこが空白なら何もせず通過、そこが空白でなければそのA1セルの文字列をキーワードにオートフィルタをかけます。

不明な点があればいってください。

通報する

#2です。

(1)原版とそっくりそのまま表示ということは最初にたろう、じろう、、、各々のシートの該当セルに原版シートを参照するように計算式をいれておくということでしょうか？

ええ、そっくり参照します。フィルタによって非表示にはなっていますが、各シートにすべてのデータ（たろうもじろうもはなこも）が格納されている状態になります。

(2)各々のシートにつけたフィルタは、毎月原版が更新される度に「▼」ボタンを押し直す必要があるようなのですが、合っていますでしょうか？

更新作業がどのようなものかわかりませんが、コピーペーストするくらいの更新作業であれば、フィルタの状況も保存されていますので、押しなおしの必要はありません。ただ新しいフィルタ（しろうとか、ごろうとか）ができると、その都度、ページをコピーしてフィルタをかけるという作業はでてしまいます。

通報する

自称imogasi方式でできます。OKWAVEでimogasi方式で照会してもらえれば、私の回答が多数出てきます。
ただし、たろう、はなこ、・・ごとに作業列が要りますが。
ーーー
関数でやる場合は、「振り分ける」と考えてはなりません。受ける側で条件に有ったものを「いただく」「取る」というイメージです。
ーーーー
VBAならA列（たろうなどの名前列）でソートし、変わるごとに隣のシートに、書き出しを移れば良い。
Sub test02()
d = Range("A65536").End(xlUp).Row
k = 2 '各シート最初行
s = 2
mk = Sheets(1).Cells(1, "A")
For i = 1 To d
If Sheets(1).Cells(i, "A") <> mk Then
s = s + 1
k = 2
End If
Sheets(s).Cells(k, "A") = Sheets(1).Cells(i, "A")
Sheets(s).Cells(k, "B") = Sheets(1).Cells(i, "B") 'AB列で他は略
k = k + 1
mk = Sheets(1).Cells(i, "A")
Next i
End Sub
A列でソートしておいて実行のこと。
シート数は十分多く作っておくこと
基シートタブは最左にあること。
タブの第２番目の左からの順のシートにセットされていく。

通報する

ＶＢＡを使った方法はすでに示されているようなので、私は原始的な方法にて。

まず、原版のシート(Sheet1)、たろうシート、はなこシート、じろーシート、さぶろーシートを用意します。

たろうシートは原版シートとそっくりそのまま表示されるようにします。
このとき、項目ラベルをつけておきます。
名前　←項目ラベル
たろう←以下オリジナルと同じように表示されるように。
たろう
じろー
・
・
・

データ(D)→フィルタ(F)→オートフィルタ(F)を選びます。
すると、項目ラベルに「▼」ボタンがでますので、押します。すると、リストが出てきますので、「たろう」を選びます。そうすると、たろうのみが表示されます。

同じように、ほかのシートもオートフィルタをかけておけば、原盤を差し替えても、それぞれフィルタが自動的にフィルタの条件に合わないデータを非表示してくれます。

通報する

VBAを使って。

i = 1
Do Until Worksheets("Sheet1").Cells(i, 1) = ""
Select Case Worksheets("Sheet1").Cells(i, 1)
Case "たろう"
tc = tc + 1
Worksheets("Sheet2").Cells(tc, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet2").Cells(tc, 2) = Worksheets("Sheet1").Cells(i, 2)
Worksheets("Sheet2").Cells(tc, 3) = Worksheets("Sheet1").Cells(i, 3)
Worksheets("Sheet2").Cells(tc, 4) = Worksheets("Sheet1").Cells(i, 4)
Worksheets("Sheet2").Cells(tc, 5) = Worksheets("Sheet1").Cells(i, 5)
Case "はなこ"
hc = hc + 1
Worksheets("Sheet3").Cells(hc, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet3").Cells(hc, 2) = Worksheets("Sheet1").Cells(i, 2)
Worksheets("Sheet3").Cells(hc, 3) = Worksheets("Sheet1").Cells(i, 3)
Worksheets("Sheet3").Cells(hc, 4) = Worksheets("Sheet1").Cells(i, 4)
Worksheets("Sheet3").Cells(hc, 5) = Worksheets("Sheet1").Cells(i, 5)
Case "じろー"
jc = jc + 1
Worksheets("Sheet4").Cells(jc, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet4").Cells(jc, 2) = Worksheets("Sheet1").Cells(i, 2)
Worksheets("Sheet4").Cells(jc, 3) = Worksheets("Sheet1").Cells(i, 3)
Worksheets("Sheet4").Cells(jc, 4) = Worksheets("Sheet1").Cells(i, 4)
Worksheets("Sheet4").Cells(jc, 5) = Worksheets("Sheet1").Cells(i, 5)
Case "さぶろー"
sc = sc + 1
Worksheets("Sheet5").Cells(sc, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet5").Cells(sc, 2) = Worksheets("Sheet1").Cells(i, 2)
Worksheets("Sheet5").Cells(sc, 3) = Worksheets("Sheet1").Cells(i, 3)
Worksheets("Sheet5").Cells(sc, 4) = Worksheets("Sheet1").Cells(i, 4)
Worksheets("Sheet5").Cells(sc, 5) = Worksheets("Sheet1").Cells(i, 5)
End Select
i = i + 1
Loop

こんな感じで。
名前が空白になるまで繰り返します。

通報する