エクセルの抽出機能が使えなくて困っています…！

質問

エクセル（2007）の抽出機能が使いこなせずに困っています…！

現在、自宅の保存食品の在庫管理表を製作しています。
その管理表の製作に伴い、賞味期限を対象とした抽出機能を
つけたいと考えています。
そこで、ＰＣのシステムの日付から一週間以内に賞味期限がくる
食品を別のシートに切り取り、あるいはコピーして一覧にしたいと
考えています。

しかし、ＰＣのシステムの日付を利用した抽出の方法がわかりません…
どうか助けてください…！
マクロやVBAを使用する形でもかまいません！

ただ、抽出の条件として今日の日付を毎回手入力で行うことは避けたいです。

どうか、よろしくお願いします…！

例）画像の場合、ＰＣの日付が2011年4月15日だった時、
　　4月16日から4月22日までの米のリストを抽出、ということがしたいです。

回答No.3

mu2011

>エクセル（2007）の抽出機能が使いこなせずに困っています
　⇒「フィルタオプションの設定」から抽出方法ですが如何でしょうか。
　（１）画像シートをSheet1、抽出シートをSheet2として、Sheet1のI1～J1は未入力、I2に=A2="米"、J2に=E2>today()、K2に=E2<=today()+7
　（２）Sheet2のA1を選択→データタブの詳細設定→「指定した範囲」を選択、リスト範囲欄をクリックし、マウスでSheet1→A:Fを選択、検索条件範囲欄をクリック→Sheet1→I1:K2を選択、抽出範囲欄をクリックしマウスでA1を選択→ＯＫ
　（３）この（２）操作をマクロ記録しておくと以後の操作が簡単になります。

エクセル関連について参照したＵＲＬを添付しますので参考にして下さい

参考URL：

http://www.eurus.dti.ne.jp/~yoneyama/

お礼

回答ありがとうございます！
とてもスマートなやり方ですね！
目から鱗がおちました！！
ぜひ採用させてもらいます！
ありがとうございました＼（＾0＾）／

回答No.2

kagakusuki

今仮に、元のデーターの表が存在しているシートがSheet1で、抽出したデーターをSheet2に表示するものとします。

　まず、Sheet2にSheet1と同じ型式の表（項目名と罫線のみで、データーは未入力）を作成して下さい。
　次に、Sheet2のE2セルに次の数式を入力して下さい。

=IF(ROWS($2:2)>COUNTIF(Sheet1!$E:$E,"<="&TODAY()+7),"",SMALL(Sheet1!$E:$E,ROWS($2:2)))

　次に、Sheet2のF2セルに次の数式を入力して下さい。

=IF($E2="","",INDEX(Sheet1!F:F,SUMPRODUCT(ROW(Sheet1!$E$1:INDEX(Sheet1!$E:$E,MATCH(9^9,Sheet1!$E:$E)))*(Sheet1!$E$1:INDEX(Sheet1!$E:$E,MATCH(9^9,Sheet1!$E:$E))=$E2)*(COUNTIF(Sheet1!$E$1:INDEX(Sheet1!$E:$E,ROW(Sheet1!$E$1:INDEX(Sheet1!$E:$E,MATCH(9^9,Sheet1!$E:$E)))),$E2)=COUNTIF($E$1:$E2,$E2)))))

　次に、Sheet2のF2セルをコピーして、Sheet2のA2～D2の範囲に貼り付けて下さい。
　次に、Sheet2のC2セルとE2セルのセルの書式設定を、[日付]にして下さい。
　次に、Sheet2のA2～F2の範囲をコピーして、同じ列の3行目以下に貼り付けて下さい。

　以上です。

お礼

回答ありがとうございます！
一つのセルにここまで長い数式を入力した経験が
なかったのでびっくりしましたが上手くいきました！
とても助かりました（^^）

回答No.1

keithin

Sub macro1()
　with worksheets("Sheet1")
　　.autofiltermode = false
　　.range("E:E").numberformatlocal = "yyyy/m/d"
　　.range("E:E").autoFilter field:=1, criteria1:=">=" & format(date + 1, "yyyy/m/d"), _
　　　operator:=xland, criteria2:="<=" & format(date + 7, "yyyy/m/d")

　　worksheets("Sheet2").cells.clearcontents
　　.range("E1").currentregion.copy destination:=worksheets("Sheet2").range("A1")
　　.autofiltermode = false
　end with
End Sub

お礼

回答ありがとうございます！
こちらはＶＢＡですよね、現在勉強している最中なので
とても参考になりました（＾＾）