EXCELでの行の抽出

質問

sheet1に

　　A　　　　B　　　　C　　　　D
1　日付　金額　　備考　　コード
2　01　　1000　あいう　　　　1
3　10　　2000　えおか　　　　3
4　20　　3000　きくけ　　　　4
5　30　　4000　こさし　　　　1
.
.
.
という感じで元データ（１００行ほど）が入っています。
これを元にしてsheet2に

　　A　　　　B　　　　C　　　　D
1　　1
2　日付　金額　　備考　　コード
3　01　　1000　あいう　　　　1
4　30　　4000　こさし　　　　1
.
.
.
というふうに表示したいのです。
sheet2のセルA1に入っているコードと一致するコードが入っているsheet1の行を抽出してsheet2に行の隙間なく表示させたいのです。
こんなことはできるのでしょうか？
メニューからコマンドを選択して・・・という方法ではなく、計算式かマクロで実現したいのです。
エクセル２０００、Ｗｉｎ９８です。よろしくお願いします。

回答No.3

noname#1523 · ベストアンサー

マクロでの回答が出ている様ですので、関数のみで行う方法を紹介します

【考え方】
１）Sheet1の最左端に作業用の列を１つ設けます
２）作業用列に、Sheet2のA1と同じ値がE列（質問例示のD列：コード）が
　　同じであれば、E列にその行まで出てきたコードの数をセットします
　　==>Sheet2A1と同じコードのデータのみ
　　　　1・2・3・4・・と連番がセットされます
３）あとは、Sheet1上で連番を元にVLOOKUP関数で参照します

【設定手順】
１）Sheet1のA列名を右クリックして"挿入"を選択し、作業列を挿入
２）Sheet1のA2セルに以下の式を入力してA3～Anにコピーします
　　　=IF(E2="","",IF(E2=Sheet2!$A$1,COUNTIF($E$2:E2,E2),""))

　　　　　・E2(コード)が空白の時は空白をセット
　　　　　・E2がSheet1のA1と同じであれば、E2から現在行のE列までの
　　　　　　E2と同じコードの数をセットします
　　　　　・コードが異なる場合は空白をセットします

３）Sheet2のA3セルに以下の式を入力してA3～Dnにコピーします
　　　=IF(ISNA(VLOOKUP(ROW()-2,Sheet1!$A:$E,COLUMN()+1,FALSE)),"",VLOOKUP(ROW()-2,Sheet1!$A:$E,COLUMN()+1,FALSE))

　　　　　・VLOOKUPで検索がエラーになった場合空白をセットする為に
　　　　　　ISNA関数でVLOOKUPを試行してチェックします
　　　　　・エラーでない時改めてVLOOKUPで検索し値をセットします
　　　　　　　VLOOKUP(検索値,検索範囲,参照列,検索の型)
　　　　　　　　●検索値：ROW()-2　現在行番号から表示行まで行数を減算し
　　　　　　　　　　　　　　　　　　１・２・３・・・と変化させます
　　　　　　　　●検索範囲：Sheet1!$A:$E　（絶対参照でA～E列とします）
　　　　　　　　●参照列：COLUMN()+1
　　　　　　　　　　　　　Sheet2のA列に検索範囲の2列目
　　　　　　　　　　　　　Sheet2のB列に検索範囲の3列目・・と表示するので
　　　　　　　　　　　　　現在列番号-1とする事で列に対応した値を参照します
　　　　　　　　●検索の型：FALSE　同一検索値のみとします

＊＊＊＊＊以上でご質問の表示が可能になります＊＊＊＊＊＊

AnやDnとあるセルは、入力が予想される行数より多めにセットしても
式内でデータの有無を判断していますので、問題有りません。

お礼

ご回答ありがとうございました。
マクロを使わなくてもできるんですね！（正直なところマクロを使わないと無理かな・・・と思っていましたので)
わたしにはこのような方法は思いもつきませんでした。
この方法を採用させて頂こうと思います。本当にありがとうございました。

回答No.2

imogasi

エクセルのシートに下記Ａのデータをテスト的に作りました。
そして下記VBAをModule1に入力し、実行しました。
するとBのように抽出できました。
------------
Sub Test01()
Range("A1:C10").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= Range("A12:C13"), Unique:=False, copytorange:=Range("a15")
End Sub
(1行の文字数制限で、改行が無理に行われている部分が
発生すると思いますが、ご注意下さい。）
見だしのコード１ コード２ コード３も含めてRange
指定してください。CriteriaRangeも同じように、
見だしのコード１ コード２ コード３も含めてRange
指定してください。
－－－－－Ａ－－－－－
コード１ コード２ コード３
a cc 1
s vv 2
d bb 3
g gg 1
h hh 1
j ee 4
u rr 5
I t 4
o uu 1

コード１ コード２ コード３
1
－－－－－Ｂ－－－－－－
コード１ コード２ コード３
a cc 1
g gg 1
h hh 1
o uu 1

お礼

ご回答ありがとうございました。
同じ結果を得るにも色々な方法があるんですね。とても勉強になります。

回答No.1

nishi6

Sheet2のA1に数値を入力してマクロ『抽出』を実行します。

ツール→マクロ→Visual Basic Editor でVBE画面に移り、挿入→標準モジュールで標準モジュールを挿入し下記コードを貼り付けます。

シートは、Sheet1、Sheet2として、転記する範囲も質問通りです。
また、マクロを実行する前に、シート２は初期化しています。（前の出力を消去）

ご参考に。

Sub 抽出()
　　Dim ws1 As Worksheet 'シート１
　　Dim ws2 As Worksheet 'シート２
　　　　Set ws1 = Worksheets("Sheet1")
　　　　Set ws2 = Worksheets("Sheet2")
　　Dim kijyun As Long 'シート２のA1の値
　　　　kijyun = ws2.Range("A1").Value

　　'シート２をきれいにする
　　With ws2
　　　　.Cells.ClearContents 'シート２をクリアする
　　　　.Range("A1") = kijyun 'A1を書き直し
　　　　.Range("A2:D2").Value = ws1.Range("A1:D1").Value '表題を転記
　　End With

　　Dim rw1 As Long 'シート１の行カウンタ
　　Dim rw2 As Long 'シート２の行カウンタ
　　rw1 = 2: rw2 = 3
　　With ws1
　　　　'照合しながら転記する
　　　　While .Cells(rw1, 4) <> ""
　　　　　　If .Cells(rw1, 4).Value = kijyun Then
　　　　　　　　ws2.Range("A" & rw2 & ":D" & rw2).Value = .Range("A" & rw1 & ":D" & rw1).Value '値を転記
　　　　　　　　rw2 = rw2 + 1
　　　　　　End If

　　　　　　rw1 = rw1 + 1
　　　　Wend
　　End With
End Sub

お礼

ご回答ありがとうございました。
とても勉強になりました。マクロが使いこなせるとエクセルでもいろんなことができそうですね。