[[20050303162652]]　『データの抽出と並び替えについて』（TOMOKI）　ページの最後に飛ぶ

『データの抽出と並び替えについて』（TOMOKI）　

◆sheet1◆

    A   　  B  　　 C       　D   　　E   
1 受注日　出荷先　　品名　　　数量　　出荷日
2  2/27　 Ａ社　　えんぴつ　　10本　　3/1
3  2/28 　Ｂ社　　えんぴつ　　 5本　　3/2
4  2/28 　Ａ社　　消しゴム　　 5個　　3/2
5  3/1　　Ｃ社　　　定規　　　15個　　3/4
6  3/2　　Ｆ社　　消しゴム　　20個　　3/4
7  3/3　　Ａ社　　消しゴム　　10個　　3/5
8
･
･

 sheet1のデータをもとに、
 列の順番を少し並び替えて、出荷先"Ａ社"のみをまとめた表を作りたいのです。

 （以下のsheet2のように）

◆sheet2◆

    A       B       C      　D   
1 出荷日　出荷先　　品名　　　数量
2  3/1　　Ａ社　　えんぴつ　　10本
3  3/2　　Ａ社　　消しゴム　　 5個
4  3/5　　Ａ社　　消しゴム　　10個
5
･

 私が考えた方法は、
 sheet1のデータを全てsheet2にリンクさせるもので、
 Ｂ列には、　　出荷先がＡ社ならば表示、違うなら空白
 その他の列は、出荷先が空白ならば空白、違うならsheet1の相対するデータを表示
 という式を入力し、出荷先をオートフィルタで"Ａ社"を選択して、Ａ社のデータを表示させる。
 というものです。

 式を書きますと、
 A2：=IF(B2="","",sheet1!E2)
 B2：=IF(sheet1!B2="Ａ社",sheet1!B2,"")
 C2：=IF(B2="","",sheet1!C2)
 D2：=IF(B2="","",sheet1!D2)
 としました。

 しかし、もとのデータが膨大な数で、出荷先がＡ社以外のところもたくさんあります。
 すると、全てリンクさせてありますので、空欄の行がたくさんできてしまいます。
 今回教えてほしい方法は
 出荷先がＡ社の行のみsheet2にリンクさせ、それ以外はリンクさせない方法です。

 宜しくお願いします。

 ※OSのバージョンは、windows98
 　エクセルのバージョンは、Excel2000です。

 フィルタオプションの設定ではダメですか?
 Sheet2のA1:D1はあらかじめ項目を入力し、抽出条件をF1:F2に入力しているとして、
 Sheet2をアクティブにした状態でデータ→フィルタ→フィルタオプションの設定　
リスト範囲：Sheet1!$A$1:$E$7
検索条件範囲：$F$1:$F$2
抽出範囲：$A$1:$D$1
といった感じになります。
	A	B	C	D	E	F
1	 出荷日	出荷先	品名	数量		出荷先
2	3月1日	Ａ社	えんぴつ	10本		Ａ社
3	3月2日	Ａ社	消しゴム	5個		
4	3月5日	Ａ社	消しゴム	10個		
　　(Hatch)

さっそくのご返事ありがとうございます。

 この方法では、少し問題があるのです。
 sheet1のデータは日々更新していくものであり、検索条件範囲が定まりません。

 そしてこの方法ですと、sheet1にデータを入力する度に、この方法をやり直さなくてはなりませんよね？
 それとも自動で更新されますか？

 私としましては、sheet1にデータを入力する度に、
 Ａ社かどうか判別して自動的にsheet2に反映されるという形が望ましいのです。

 ほかにいい方法はありますか？
 よろしくお願いいたします。

 （TOMOKI）

 >それとも自動で更新されますか？
フィルタオプションを自動で行うためマクロ化すると、こんな感じになるかと思います。
Sheet2でボタンをクリックしないといけませんが・・・
 (Hatch)
Sub test01()
Dim lastRow1 As Long, lastRow2 As Long
    lastRow1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
    lastRow2 = Worksheets("Sheet2").Range("A65536").End(xlUp).Row
'Sheet2の抽出データをクリア
    Worksheets("Sheet2").Range(Cells(2, 1), Cells(lastRow2 + 1, 4)).ClearContents
'フィルタオプションの設定でデータ抽出
    Worksheets("Sheet1").Range("A1:E" & lastRow1).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Worksheets("Sheet2").Range("F1:F2"), CopyToRange:=Worksheets("Sheet2").Range("A1:D1"), Unique:=False
'出荷日順に並べ替え
    Range("A1:D6").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
End Sub

 横からお邪魔します。。
シート2に見出しは普通にあるとして
シート2のA2に
=IF(Sheet1!$B2="Ａ社",Sheet1!E2,"")
B2に
=IF(Sheet1!$B2="Ａ社",Sheet1!B2,"")
と入力して右にコピーします。
A2からD2を選択した状態で下に必要分コピーします。
すると、飛び飛びにデータが表示されます。これでは今のままなので
次にシート2の見出しを右くりっく→コードを表示させてそこに
Private Sub Worksheet_Activate()
Range("A1").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End Sub
を貼り付けます。このコードはシート2のB列を基準に降順で並び替えを記録したものです。
一度、シート1に戻ってもう一度シート2を選択したらご希望通りになってませんでしょうか？？
どうでしょうか？？
（SoulMan）

 関数で処理するとしたら、作業列を使いますが、
 1)Sheet1のF2に=IF(B2="Ａ社",COUNTIF($B$2:B2,"Ａ社"),"")
 として下方向へ必要と思われるだけコピーしておく。
 2)Sheet2のA2=IF(ISNA(MATCH(ROW(A1),Sheet1!$F$2:Sheet1!$F$50000,0)),"",INDEX(Sheet1!$E$2:Sheet1!$E$50000,MATCH(ROW(A1),Sheet1!$F$2:Sheet1!$F$50000,0)))
 3)Sheet2のB2=IF(ISNA(MATCH(ROW(B1),Sheet1!$F$2:Sheet1!$F$50000,0)),"",INDEX(Sheet1!B$2:Sheet1!B$50000,MATCH(ROW(B1),Sheet1!$F$2:Sheet1!$F$50000,0)))
 　C2:D2へコピーする。
 4)Sheet2のA2:D2を下方向へ必要と思われる分だけコピーしておく。
 で、どうでしょうか？　　　(Hatch)

 ご回答ありがとうございました。
 簡易表で試したところ、どちらもスムーズにできましたが、
 本当の表で試したところ、マクロの方がうまくいきませんでした。

 実行時エラー'1004';
 この操作には、同じサイズのセルが必要です。

 と表示されます。
 これは何が原因と考えられますか？
 コードをそのまま貼り付けてよかったのでしょうか。
 表の並び・内容等に合せて変更しなければならない点とかありますか？

 あと、SoulManさんのマクロの方法と、Hatchさんの関数のやり方では、
 どちらが容量は少なくていけるでしょうか。
 なにせ、古いパソコンでただでさえ動きが鈍く、
 いつ固まってしまうか心配という状況ですので。。

 よろしくお願いします。(TOMOKI)

 原因は結合セルです。データベースと結合セルは相性最悪。
あと、マクロでエラーが出たときはどの行で停止しているか書いていただけると
検証がスムーズです。
（みやほりん）

 セルの結合を解除したら、スムーズにできました。
 データベースと結合セルは相性悪いんですね。知らなかったです。
 ありがとうございました！！(TOMOKI)

コメント返信：

[ 一覧(最新更新順) ]

[[20050303162652]] 『データの抽出と並び替えについて』（TOMOKI） ページの最後に飛ぶ

[[20050303162652]]　『データの抽出と並び替えについて』（TOMOKI）　ページの最後に飛ぶ