人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルでの抽出についての質問です。

Sheet1に製品名、価格、入荷日、出荷日、発送日、納品日の日付が
下に並んでいるセルがあります。

これをSheet2のA1に日付を例えば10月27日と入力したら
その下に、入荷日または出荷日または発送日または納品日の
いづれかに10月27日とあるものを抽出することは可能でしょうか?

これをアクセスでやることって簡単ですか?

またフォームに日付を入力したら、
レポートで1ページ内に項目ごとに、
●入荷日
製品名 価格

●出荷日
製品名 価格

●発送日
製品名 価格

●納品日
製品名 価格
なんていうのが出力できたらうれしいです。。。
アクセス初心者の自分には敷居は高いですか?
実現する方法、やり方、参考ページなど
ぜひ教えてください。

よろしくお願いいたします。

●質問者: ohtsu6
●カテゴリ:コンピュータ
✍キーワード:10月27日 A1 とある アクセス エクセル
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● Mook
●10ポイント

アクセスはあまり詳しくないので、とりあえずEXCEL で実行するための方法です。


Sheet1(一番左のシート)のA?Fにそれぞれ、データが入っておりSheet2は空のシートと想定しますが、

Sheet2のタブを右クリックし、「コードの表示」を選択して開いたウィンドウに下記のコードを貼り付けてください。

Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
 
 Dim dstLine As Long
 dstLine = 2

 Dim lastLine As Long
 lastLine = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
 Range("A2:F" & lastLine).Clear 

 Dim i As Long
 For i = 2 To lastLine
 For j = 3 To 6
 If Worksheets(1).Cells(i, j).Value = Range("A1").Value Then
 Worksheets(1).Rows(i).Copy Destination:=Rows(dstLine)
 Cells(dstLine, j).Interior.ColorIndex = 35
 dstLine = dstLine + 1
 End If
 Next
 Next
End Sub

Sheet2 のA1に日付を入れると、その下に該当するものが表示されます。

◎質問者からの返答

Mook さま

どうもありがとうございます。

上記をためしてみたのですが、

lastLine = から Range("A2:F" & lastLine).Clear

でコンパイルエラーになってしまいます。。。

どのようにすればよろしいでしょうか?

どうぞよろしくお願いいたします。


2 ● Mook
●10ポイント

コメントが有効でなかったので、再回答で失礼します。

 lastLine = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row

 lastLine = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row

に修正してください。


失礼しました。

(スーパープレ記法まだバグってる・・・。)

◎質問者からの返答

Mook さま

出来ました。どうもありがとうございます。


もしよろしかったら下記3点についても教えてください。

Sheet1の項目名をSheet2に表示することは可能でしょうか?

項目がないと何の日付かわからないので。。。


入荷日、出荷日、発送日、納品日で重複していると

重複している分だけ表示されてしまいます。

重複をさせないことは可能でしょうか?


また、日付で指定していましたが、

これを10月27日?10月29日というような感じで

期間で指定することは可能でしょうか?

どうぞよろしくお願いいたします。


3 ● Mook
●1480ポイント ベストアンサー

一応ご希望の仕様にあわせて機能を拡張した例です。

A1に日付範囲の開始日、B2に日付範囲の終了日を入力してお試しください。

Private Sub Worksheet_Change(ByVal Target As Range) 
 If Intersect(Target, Range("A1:B1")) Is Nothing Then Exit Sub
 If Not IsDate(Range("A1")) Then Exit Sub
 
 Application.EnableEvents = False
 Dim startDate As Date
 startDate = Range("A1")
 
 Dim endDate As Date
 If IsDate(Range("B1")) Then
 endDate = Range("B1")
 Else
 endDate = startDate
 End If
 
 Dim i%, j%
 Dim lastLine As Long
 
 
 lastLine = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
 Range("A2:F" & lastLine).Clear
 Range("A2:F2") = Array("製品名", "価格", "入荷日", "出荷日", "発送日", "納品日")
 
 Dim dstLine As Long
 Dim dd As Date
 Dim isFirst As Boolean
 dstLine = 2
 For i = 2 To lastLine
 isFirst = True
 For j = 3 To 6
 For dd = startDate To endDate
 If Worksheets(1).Cells(i, j) = dd Then
 If isFirst = True Then
 dstLine = dstLine + 1
 Worksheets(1).Rows(i).Copy Destination:=Rows(dstLine)
 isFirst = False
 End If
 Cells(dstLine, j).Interior.ColorIndex = 35
 End If
 Next
 Next
 Next
 Range("A2:F" & dstLine).Borders.Weight = xlThin
 Range("A2:F2").Interior.ColorIndex = 36
 Application.EnableEvents = True
End Sub

不明な点はコメントにて対応しますので、コメントを有効にお願いします。

◎質問者からの返答

思い通りのものが出来ました。

また何か伺うこともあるかもしれませんが、

よろしくお願いいたします。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ