[[20180525001514]]　『セルのデータ一致した場合表示』（a-su）　ページの最後に飛ぶ

『セルのデータ一致した場合表示』（a-su）

シートＡＢＣにデータが格納されています。
セルA2:A5は商品名、セルB1:E1は日付、B2:E5は数量が入力されています。

シートＸに条件に一致したデータを表示します。
B1に日付を入力し、その日付の商品の数量が1以上であれば、その商品名と値を表示させたいのですが、VBAで作成できますでしょうか？ご教授お願いします。

シートＡＢＣ

     A        B      C     D     E
1　商品名   5/25    5/26  5/28  6/1
2  りんご　   1　　　　　　2
3　もも　　   1　　　2　　 5
4  みかん　   5　　　　　　　　　5
5　すいか　　　　　　10    5     6

シートＸ
　　A　　　 B
1 商品名　　　 5/28
2 りんご　　　 2
3　もも　　　　 5
4　すいか　　　 5

＜使用 Excel：unknown、使用 OS：unknown ＞

 VBAで作成できると思います。
 シートXのB1に日付が入力されたら、
 シートABCの1行目から同じ日付を検索してヒットしたら列番号を取得、
 今度はそのヒットした列からデータのある行数分みて、
 値が1以上であればA列とヒット列の行をシートXに転記
 というような流れとなると思います。

 どの辺がわからないか、もう少し絞られますと回答がつきやすくなりますよ。
（ろっくん） 2018/05/25(金) 10:49

ろっくんさんありがとうございます。

ご説明のとおり、VBAで作成したいと思っています。
検索はHLOOKUPで出来ますが、値が1以上の場合に、商品名と数量を表示させたいです。
値が1以上の時を表示するVBAのコードがわかりません。
（a-su） 2018/05/25(金) 12:32

 ＞値が1以上の時を表示するVBAのコードがわかりません。
サンプル　みたいなものですが。。。　＾＾

 Sub atai()
    Dim atai As Long
    atai = 10
    If atai >= 1 Then
        MsgBox atai
    End If
End Sub
（隠居じーさん） 2018/05/25(金) 12:53

 VBAで日付の検索は厄介ですね・・。
 ひとまずシートXのイベントとして作成してみています。
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim fdRng As Range
    Dim Rng As Range
    Dim i As Long
    If Target.Address(0, 0) = "B1" Then
        Application.EnableEvents = False
        Sheets("X").Range("A2:B" & Sheets("X").Range("A2").CurrentRegion.Rows.Count).ClearContents
        With Sheets("ABC")
            Set fdRng = .Range("1:1").Find(What:=DateValue(Target.Value), LookAt:=xlWhole, LookIn:=xlFormulas)
            If Not fdRng Is Nothing Then
                For i = 2 To .Cells(.Rows.Count, fdRng.Column).End(xlUp).Row
                    If .Cells(i, fdRng.Column) >= 1 Then
                        Set Rng = Sheets("X").Range("A" & Sheets("X").Rows.Count).End(xlUp).Offset(1)
                        Rng.Value = .Cells(i, 1).Value
                        Rng.Offset(, 1).Value = .Cells(i, fdRng.Column).Value
                    End If
                Next i
            End If
        End With
        Application.EnableEvents = True
    End If
 End Sub
（ろっくん） 2018/05/25(金) 14:03

Sub Sample()

    With Sheets("Ｘ")
        .Range("E1").FormulaR1C1 = "=RC[-3]"
        .Range("E2").Value = ">0"
        Sheets("ＡＢＣ").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=.Range("E1:E2"), CopyToRange:=.Range("A1:B1"), Unique:=False
    End With

End Sub
（きまぐれ） 2018/05/25(金) 14:28

皆さまありがとうございます。
こんなに、簡単なコードでできるのですね。
（a-su） 2018/05/25(金) 21:29

コメント返信：

[ 一覧(最新更新順) ]

[[20180525001514]] 『セルのデータ一致した場合表示』（a-su） ページの最後に飛ぶ

[[20180525001514]]　『セルのデータ一致した場合表示』（a-su）　ページの最後に飛ぶ