エクセルの名簿抽出貼付けについて

Question

シート１に名簿があります。
A列　　　  B列　　　 C列　D列　  E列　  F列　 G列　 H列　・・・・
通し番号　クラス　　名前　部活　趣味　部活　趣味　部活　・・・　
D列E列は１年時の部活と趣味
F列G列は２年時の部活と趣味です。
これが縦に１００名以上、横には６年分くらい続きます。
で、シート２には
A列　　　 C列　 D列　  E列
通し番号　名前　部活　趣味
の枠だけがあります。およそ４０名分の枠です。
そこで、シート１のあるセルに「２」「３」と入れてマクロボタンを
押すと、シート２に「３組の２年時のデータ」の名簿が出来上がる
という抽出、コピー、貼付けのマクロを教えてください。
貼付けるのは、名前と部活と趣味だけですが、まず抽出方法が？です。
よろしくお願いします。

tom04 · Accepted Answer

No．3です！
たびたびお邪魔します。

＞シート２に「学年」「クラス」のセルがあってもできるということですよね？

に関しては「そのとおり！」ということになります。
そして、配列数式を使っている関係上、コンピュータへの負担を心配されていましたので、
作業用の列を設けて、少し負担を少なくする方法を書いておきます。
もう一度画像をアップさせていただきます。

Sheet1の最終列に作業用の列を設けて、今回はSheet2に年時とクラスを入力するようにしてみました。
作業列P3セルに
=IF(OR(Sheet2!$C$1="",B3<>Sheet2!$C$1),"",ROW(A1))
としてオートフィルで下へコピー又はP3セルのフィルハンドルでダブルクリック。

今回もSheet2の各列の数式は違いますので、それぞれのセルに数式を入力する必要があります。
（配列数式はありません）

Sheet2のA3セルに
=IF(COUNT(Sheet1!$P$3:$P$200)<ROW(A1),"",INDEX(Sheet1!$A$3:$A$200,SMALL(Sheet1!$P$3:$P$200,ROW(A1))))
B3セルに
=IF(A3="","",VLOOKUP(A3,Sheet1!$A$3:$C$200,3,0))
C3セルに
=IF(A3="","",INDEX(Sheet1!$D$3:$O200,MATCH(A3,Sheet1!$A$3:$A200,0),$A$1*2-1))
D3セルに
=IF(A3="","",INDEX(Sheet1!$D$3:$O200,MATCH(A3,Sheet1!$A$3:$A200,0),$A$1*2))

として、前回同様全てを範囲指定しオートフィルで下へコピーします。
これで少しはコンピュータも軽くなると思います。

以上、今回も長々と書いてしまいました。
参考になれば幸いです。m(__)m

Nouble · Answer

　　　A　　　B　　　C　　　D　　　E　　　F　　　G…

　1　 No.　クラス　名前　部活　趣味　部活　趣味…
　2　 1　　　1　　高木　柔道　生け花　柔道　生け花…
・　・　　　・　　・　　・　　・　　・　　・　…
・　・　　　・　　・　　・　　・　　・　　・　…
・　・　　　・　　・　　・　　・　　・　　・　…
・　・　　　・　　・　　・　　・　　・　　・　…
312　311　　 3　　青木　・　　・　　・　　・　…
・　・　　　・　　・　　・　　・　　・　　・　…
・　・　　　・　　・　　・　　・　　・　　・　…
・　・　　　・　　・　　・　　・　　・　　・　…
・　・　　　・　　・　　・　　・　　・　　・　…
(※左端はセルの行ナンバー)

こんな感じの表だと仮定します
更にシート1のP1に検索対象組ナンバー、P2に検索対象学年が数値として入っているものとします
エラー処理は省きますね
A1に
=OFFSET(Sheet1!$A$1,SMALL(INDEX((Sheet1!$P$1<>Sheet1!$B:$B)*1100000+ROW(Sheet1!$B:$B),0,0),ROW($A1)),COLUMN(A$1),1,1)
C1にA1をコピー
D1に
=OFFSET(Sheet1!$A$1,SMALL(INDEX((Sheet1!$P$1<>Sheet1!$B:$B)*1100000+ROW(Sheet1!$B:$B),0,0),ROW($A1)),COLUMN(A$1)+Sheet1!$P$2*2,1,1)
D1をE1にコピー
この1行目を
40行目までフィルハンドルなどで数式コピー

如何でしょうか
御役に立てたなら幸いです

keithin · Answer

＞貼付けるのは、名前と部活と趣味だけです

とは，貼り付け先シートのA列は残すという意味だったんですね。

Sub macro1r1()
Dim nen
Dim cls
nen = InputBox("学年")
cls = InputBox("クラス")
If nen = "" Or cls = "" Then Exit Sub

Application.ScreenUpdating = False
Worksheets("Sheet2").range("C:E").ClearContents

With Worksheets("Sheet1")
　.AutoFilterMode = False
　.Range("B:B").AutoFilter field:=1, Criteria1:=cls
　.Range("C:C").Copy _
　　Destination:=Worksheets("Sheet2").Range("C1")
　.Range("B:C").Offset(0, nen * 2).Copy _
　　Destination:=Worksheets("Sheet2").Range("D1")
　.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub

とかなんとか。

tom04 · Answer

こんばんは！
VBAでないので参考にならなかったら無視してください。
関数を使った一例です。

↓の画像で上側がSheet1で下側のSheet2に抽出する方法です。

今回はSheet2の各列に違う数式を入れていますので、列方向へのコピーは考えていません。
Sheet2のA2セルに
=IF(COUNTIF(Sheet1!$B$3:$B$200,Sheet1!$C$1)<ROW(A1),"",INDEX(Sheet1!$A$3:$A$200,SMALL(IF(Sheet1!$B$3:$B$200=Sheet1!$C$1,ROW($A$1:$A$198)),ROW(A1))))
これは配列数式になってしまいますので、この画面からコピー＆ペーストしただけではエラーになると思います。
貼り付け後、F2キーを押す、又は貼り付けセルでダブルクリック、又は数式バー内で一度クリックします。
編集可能になりますので、Shift＋Ctrlキーを押しながらEnterキーで確定してください。
数式の前後に｛　｝マークが入り配列数式になります。
残りの3列の数式は配列数式ではありません、単に貼り付けだけでOKです。
B2セルに
=IF(A2="","",VLOOKUP(A2,Sheet1!$A$3:$C$200,3,0))
C2セルに
=IF(A2="","",INDEX(Sheet1!$D$3:$I$200,MATCH(A2,Sheet1!$A$3:$A$200,0),Sheet1!$A$1*2-1))
D2セルに
=IF(A2="","",INDEX(Sheet1!$D$3:$I$200,MATCH(A2,Sheet1!$A$3:$A$200,0),Sheet1!$A$1*2))
という数式を入れ、A2～D2セルを範囲指定し、D2セルのフィルハンドルで下へコピーすると
画像のような感じになります。
これでSheet1のA1セルに表示したい年時を、C1セルにクラスを入力すると
入力したクラスの年時のデータが抽出できると思います。

以上、長々と書きましたが
最初に書いたように的外れなら
読み流してくださいね。m(__)m

keithin · Answer

＞…のマクロを教えてください。

Sub macro1()
Dim nen
Dim cls
nen = InputBox("学年")
cls = InputBox("クラス")
If nen = "" Or cls = "" Then Exit Sub

Application.ScreenUpdating = False
Worksheets("Sheet2").Cells.ClearContents

With Worksheets("Sheet1")
　.AutoFilterMode = False
　.Range("B:B").AutoFilter field:=1, Criteria1:=cls
　.Range("C:C").Copy _
　　Destination:=Worksheets("Sheet2").Range("A1")
　.Range("B:C").Offset(0, nen * 2).Copy _
　　Destination:=Worksheets("Sheet2").Range("B1")
　.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub

とかなんとか。

CoalTar · Answer

>まず抽出方法が？です。
フィルタオプションの設定を使えば抽出可能です。
そのためには項目に重複があってはいけません。
よって、部活1年 趣味1年 と２セル分書いて2セル選択して横へオートフィル
部活1年趣味1年部活2年趣味2年部活3年趣味3年部活4年
とするのはどうでしょうか？

Sheet2には
通し番号　名前　="部活"&学年&"年"　="趣味"&学年&"年"
のようにしておく。(タイトルは学年を参照するようにする)

フィルタオプションは Sheet2の何も書いてないセルで行います。
●指定した範囲
リスト範囲 Sheet1!$A$1:$N$44
検索条件範囲 $F$1:$F$2
抽出範囲 $A$1:$D$1
添付図参照

G2セルを名前の定義で「学年」にしています

マクロを使えば項目の重複も可能だと思いますが、フィルタを覚えてからでも遅くはないと思います
その後、マクロを自動記録してみると良いと思います。