Excelでの複数結果抽出がわかりません

質問

商品の日毎受注個数の一覧表をExcelで作成しています。

A列には日付
B列にはその日の受注個数　が並んでいます。
そしてB列中の最大値、最小値をE1、E2に関数で表示させています。

B列からE1、E2セル参照で最小値を検索し、隣A列の日付をE1の右隣セルから右方向に並べて複数抽出したいのですが、（該当する日付をすべて表示）どのような関数、マクロを書けば良いでしょうか？

回答No.3

KonnaMonde

>日付が若い順で抽出、表示させていきたい場合には、B列の下から上に処理をしていけば良いのではないかと考えました。

考え方は、その通りです。　
　　For …Each…Next　
構文を使う場合は、エクセルは、左から右、上から下へと選択範囲内のセルを順に拾っていきます。

>日付が若い順で抽出、表示させていきたい場合

２通りの方法が考えられます。　

1つ目は、あなたの考えられた方法です。　この場合は、　For …Each…Next　構文は使えませんので、別の方法で各セルを抽出するコードに書き換えることになります。

もう１つは、各セルを辿るのは上からですが、表示のときに、古い日付(Ｆ列より右側のセル全部)を右の方に１セル移動させ、最新の日付を常にＦ列に入れる方法です。　この方法は、サンプルのコード中、取り出した日付を表示する時の方法の部分のコードを書き換えれば実現します。　

ついでに、抽出した日付の欄のセル幅を　AutoFit　するコードも付け加えておきます。

'　再下段から上方にデータをチェックしていく方式　 　　Ｒ１Ｃ１参照方式
Sub MaxMin2()
　　Dim r As Long, re As Long
　　Dim c As Integer, ce As Integer
　　Dim n As Integer

'　---　Ｂ列最下段の行番号　取得　---
　　re = Cells(Rows.Count, 2).End(xlUp).Row
'　---　最下段から上方に１行ずつ処理していく　---
　　For r = re To 1 Step -1
　　　　n = Cells(r, 2).Value
　　　　If n = Cells(1, 5).Value Then
　　　　　　ce = Cells(1, Columns.Count).End(xlToLeft).Column + 1
　　　　　　Cells(1, ce).Value = Cells(r, 1).Value
　　　　End If
　　　　If n = Cells(2, 5).Value Then
　　　　　　ce = Cells(2, Columns.Count).End(xlToLeft).Column + 1
　　　　　　Cells(2, ce).Value = Cells(r, 1).Value
　　　　End If
　　Next

'　---　F　列　より右の列幅を Auo　Ｆｉｔ　する
　　nAdr1 = Cells(1, 5).End(xlToRight).Column
　　nAdr2 = Cells(2, 5).End(xlToRight).Column
　　c = WorksheetFunction.Max(nAdr1, nAdr2)
　　Range(Columns(6), Columns(c)).AutoFit

End Sub
'

'　表示するときの方式を変更したもの
Sub MaxMin3()
　　Dim r As Long, re As Long
　　Dim c As Integer, ce As Integer
　　Dim n As Integer, Adr, mc
　　Dim Cel As Range, nAdr1 As Integer, nAdr2 As Integer

　　re = Range("B" & Rows.Count).End(xlUp).Row
　　Range("B1:B" & re).Select
　　For Each Cel In Selection
　　　　n = Cel.Value
　　　　If n = Range("E1").Value Then
’　　　--　"Ｇ１"より右のデータを１セル右にずらす(シフトする)
　　　　　　Range("F1").Insert (xlShiftToRight)
’　　　--　空欄になった"Ｆ１"セルに新しい日付を書き込む
　　　　　　Range("F1").Value = Cells(Cel.Row, 1).Value
　　　　End If
　　　　If n = Range("E2").Value Then
　　　　　　Range("F2").Insert (xlShiftToRight)
　　　　　　Range("F2").Value = Cells(Cel.Row, 1).Value
　　　　End If
　　Next

'　---　F　列　より右の列幅を Auo　Ｆｉｔ　する
　　nAdr1 = Range("E1").End(xlToRight).Column
　　nAdr2 = Range("E2").End(xlToRight).Column
　　c = WorksheetFunction.Max(nAdr1, nAdr2)
　　Range(Columns("F"), Columns(c)).AutoFit

End Sub
'

お礼

分かりやすい説明と2パターンのコード記述有難う御座います。
教えて頂いた「最新の日付を常にＦ列に入れる方法」で今度こそ集計表が完璧なものになりました！
頂いたコードはこれから構文一つ一つを追って勉強していきたいと思います、

回答No.2

hige_082

条件がよく分かりませんので
入力してあるすべてのデータから受注個数が最小の日付を
Ｆ１から右方向に表示するとして説明します

受注個数（Ｂ列）をキーとして昇順で並び替えをします
受注個数の最小から順に並んでいるので、最小個数の日付(Ａ列)をコピーします
Ｆ１を選択し、右クリック、形式を選択して貼り付けを選択
行列を入れ替えるにチェックを入れ、ＯＫ

データの並びをもとに戻す必要があるなら
最初にＣ列に連番を振っておき、最後にＣ列をキーに並べ替えをすれば
元に戻すことが出来ます

お礼

お礼が遅くなり申し訳ありません。
回答頂き有難う御座います。
関数、マクロ以外でシンプルに実現できるんですね。
参考になりました。

回答No.1

KonnaMonde

コードを簡単にするため、Ａ１参照形式とＲ1Ｃ1参照形式の双方を使っています。
これで動くはずです。　Excel2002　と　Excel2007　での動作は確認済みです。
なお、表示を整形するなどの書式の変更には対応していません。　必要最少のコードです。

Ａ列、Ｂ列のデータの数は幾つでも構いません。　
また、Ｅ１、Ｅ２のセルに入っている数字はどんな数字でも構いません。　２つのセルの数字に合致するＢ列のセルの日付を右の方に並べていきます。　この数も、エクセルが許す範囲の数(Excel2007では　16,384-5個、これ以外のバージョンでは　256-5個)までＯＫです。　　

Sub MaxMin()
　　Dim r As Long, re As Long
　　Dim c As Integer, ce As Integer
　　Dim n As Integer
　　Dim Cel As Range

　　re = Range("B" & Rows.Count).End(xlUp).Row

　　Range("B1:B" & re).Select

　　For Each Cel In Selection
　　　　n = Cel.Value
　　　　If n = Range("E1").Value Then
　　　　　　ce = Cells(1, Columns.Count).End(xlToLeft).Column + 1
　　　　　　Cells(1, ce).Value = Cells(Cel.Row, 1).Value
　　　　End If
　　　　If n = Range("E2").Value Then
　　　　　　ce = Cells(2, Columns.Count).End(xlToLeft).Column + 1
　　　　　　Cells(2, ce).Value = Cells(Cel.Row, 1).Value
　　　　End If
　　Next

End Sub

お礼

お礼が遅くなり申し訳ありません。
ご支持頂きましたマクロで望み通りのことが実現できました！
頂きましたコードもマクロ勉強中の自分には非常に参考になりました。
どうも有り難う御座いました。

補足

すみません！
追加で質問になってしまうのですが、
頂きましたマクロのループ処理をB列の最下行から上に向かって実行していくようには出来ないでしょうか？
（B列には日付の古い順で上から下に受注数が並んでいます。日付が若い順で抽出、表示させていきたい場合には、B列の下から上に処理をしていけば良いのではないかと考えました。しかし自分で試してみましたが上手くいきません）