エクセルのあるシートの内容を条件毎に行単位で複数のシートに振り分けるには？

質問

エクセルのあるシートにある元データのA列を参照して同じものだけを行単位で抜き出し、別にある50個のシートに振り分けたいのですが、手作業でコピーする以外に何か良い方法はないかと思い、質問させていただきました。

下の例で行くと行1と2は列Aが同じ「たろう」なので、同じシート2へ、行3と4は「はなこ」なので、同じシート3へといった具合です。

元データ（シート1、毎月更新）
　 A　　　B　C　D　E
1たろう　 1　2　3　4→シート2へ　
2たろう　 4　5　6　3→シート2へ
3はなこ　 7　8　9　2→シート3へ　
4はなこ　 1　2　2　1→シート3へ
5じろー　 3　4　4　3→シート4へ
6さぶろー 5　4　3　1→シート5へ

シート2：たろうのデータ2行のみ表示
シート3：はなこのデータ1行のみ表示
シート4：じろーのデータ1行のみ表示
シート5：さぶろーのデータ1行のみ表示

問題は、元データは別のソフトからエクスポートされたもので、毎月更新するたびに行数が増えたり減ったりして内容が変わってしまうところです。例えばたろうが今月は2行あったけど、来月は1行になってしまうといった具合です。各シートも元データの更新内容に従って、毎月更新する必要があります。

関数は使ったことがありますが、これは関数で実現できるのでしょうか？何となく出来ないような気がしています。やはり高度な技が必要なのでしょうか。その場合は私には難しいかもしれませんが、とにかく何かお知恵をいただきたくよろしくお願いいたします。

回答No.9

chem_taro · ベストアンサー

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

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

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

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

お礼

すみません！私が間違っていました。各ページのA1セルに名前を入れなければいけないのですね。基本ができていませんでした。今やってみたらばっちりうまく行きました。感動です。こんな風にできるのですね。使わせていただきます。最後まで教えていただいて本当にありがとうございました。

回答No.8

chem_taro

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

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

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

お礼

差し替えてみたのですが、結果は変わりませんでした。。。

回答No.7

chem_taro

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

お礼

何度もご丁寧にありがとうございます。奮闘中ですがうまくいきません。原版のデータを更新した後、Alt+F8で実行すると、各々のシートには更新前からソートで表示されていた場所のデータがそのまま表示されるようなのです。

例えばたろうのデータは始め3行目-5行目にあり、たろうのシートにはそれが表示されていますが、原版が更新されて、たろうが3行目-4行目に減り、次のじろーが5行目からになっても、たろうのシートにはそのまま5行目のじろーのデータまで表示されてしまうようです。マクロ初心者なので、やり方がまずいのかもしれません。

回答No.6

chem_taro

#5の補足です。

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

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

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

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

回答No.5

chem_taro

#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セルの文字列をキーワードにオートフィルタをかけます。

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

回答No.4

chem_taro

#2です。

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

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

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

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

お礼

お返事ありがとうございます。最初のメンバー以外に増える可能性はありませんが、例えば次月に、たろうが2行から3行になったり、はなこが3行から1行になったりはします。

その場合、たろうのシートに行くと、新たに追加された1行が表示されておらず、もう一度「▼」ボタンを押しなおして選択しないと最新の状態にならないようなのです。。これは仕方がないのでしょうか。

度々恐縮ですがよろしくお願いいたします。

回答No.3

imogasi

自称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列でソートしておいて実行のこと。
シート数は十分多く作っておくこと
基シートタブは最左にあること。
タブの第２番目の左からの順のシートにセットされていく。

お礼

ありがとうございます。たくさんご回答されているんですね。私のレベルではこれはなかなか難しそうだなということがわかってきました。

回答No.2

chem_taro

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

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

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

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

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

お礼

ありがとうございます。やってみました。2点確認させていただきたいのですが、

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

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

すみません、読解力不足かもしれません。よろしくお願いいたします。

回答No.1

ipsum11

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

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

お礼

早速のご回答ありがとうございます。正直VBAは私にはなかなか難しそうです。でもこの方法を使えばきっと思い描いている理想の感じになるのではと思います。なんとか自分でできればいいのですが。せっかく作っていただいたので試してみたいと思います。ありがとうございました。