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


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

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

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

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

●出荷日
製品名 価格

●発送日
製品名 価格

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

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

回答の条件
  • 1人5回まで
  • 登録:2007/10/28 00:39:59
  • 終了:2007/10/28 23:04:47

ベストアンサー

id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912007/10/28 16:21:22

ポイント1480pt

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

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

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

id:ohtsu6

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

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

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

2007/10/28 22:58:47

その他の回答(2件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912007/10/28 01:16:32

ポイント10pt

アクセスはあまり詳しくないので、とりあえず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に日付を入れると、その下に該当するものが表示されます。

id:ohtsu6

Mook さま

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

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

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

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

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

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

2007/10/28 10:41:28
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/10/28 11:26:30

ポイント10pt

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

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

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

に修正してください。


失礼しました。

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

id:ohtsu6

Mook さま

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


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

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

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


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

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

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


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

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

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

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

2007/10/28 12:11:27
id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912007/10/28 16:21:22ここでベストアンサー

ポイント1480pt

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

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

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

id:ohtsu6

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

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

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

2007/10/28 22:58:47
  • id:Mook
    終了日の記述が嘘でした。
    B2ではなくB1です^^;;。

    たびたびの誤記、失礼しました。
  • id:Mook
    過分なポイントとイルカ賞ありがとうございました。

    今回の回答に関しても不明な点や改善要求ありましたらコメントください。
    今週くらいはコメント気にかけるように見ておりますので。
  • id:rikuzai
    Excelで↑の動作は一応フィルタオプションでも可能ですね。
    定例作業ならマクロの方がもちろんいいと思いますが。

    また、ACCESSのレポートについては可能ですが、
    質問が終わってしまいましたね・・・。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません