[[20170123033006]]　『複数条件の検索と結果の一覧』（nao）　ページの最後に飛ぶ

『複数条件の検索と結果の一覧』（nao）

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

シート1

	[A]　　　[B]　　　[C]　　　[D]　　　[E]
[1]	玉ねぎ　みかん　　　　　　1　　　プランB
[2]	人参　　ぶどう　　　　　　2　　　プランD
[3]	セロリ　いちご　　　　　　3　　　プランA
[4]	ねぎ　　りんご
[5]	…	…

シート2

	[A]　　　　[B]　　　[C]　　　[D]　　　[E]
[1]	プランA　人参　　りんご
[2]	プランB　セロリ　みかん
[3]	プランC　里芋　　いちご　人参　　じゃがいも
[4]	プランD　セロリ　いちご　ぶどう
[5]	…　　　　…　　　　…　　　…　　　…

シート1のA列に野菜、B列に果物名が入っています。種類と個数は毎日変わります。
シート2のA列には野菜と果物を組み合わせたプラン名が500個ほど入り、
B～E列に組み合わせた野菜と果物名が2～4個入っています。

シート1にある野菜と果物で構成できるプラン名をE列に羅列したいのですが（可能であればプラン名の順番はランダムで）、
どのようにすればいいかお教え願えますか。
どうぞよろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

プランの組み合わせは完全一致ですか？

記載されました例で見ますと、プランDは４つの内容で成り立っていますが、シート1のプランDに該当する行は２つしか内容が入っていないように見受けられます。

完全一致か部分一致かを教えてください。

完全一致ならシート1シート2に1列ずつ挿入して

=A1&B1&C1&D1で内容を１つにまとめたセルを作り、Vlookupで検索すればよろしいかと思います。
（pooh） 2017/01/23(月) 09:21

まず、貴方はどうすれば実現できるだろう？、と考えましたか？それを教えてください。
やりたいことだけ書いて、お願いします、というのは、丸投げといって、自分で考える事を放棄した、学ぶ気持ちの無い人ですよ～、と言っているようなもの。歓迎されるものではありませんよ。

参考までに、考え方だけ書きますと、まずA列B列のデータは、Excelにとっては等価であり、分ける意味のないものです。なので、これを1列にまとめるか、配列やDictionaryオブジェクト等を使って、一次元の素材配列にしてしまいます。

次に、プランをランダムにするため、プラン名を別の一次元配列に格納します。これをForループで全件数分回し、RND関数を使いながら中身を入れ替えていきます。

これで前準備はできました。次に、プラン名配列の1件目から順に、素材配列の中に該当素材が存在するかチェックします。全ての素材が存在する場合、これをプランとして1件出力します。 1つでも足りない素材があるならば、次のプランをチェックします。これを繰り返し、3つのプランが揃うまでループさせれば、完成です。
（???） 2017/01/23(月) 09:30

poohさんに私の解釈を説明しますと、A列はあるだけの野菜名が羅列されていて、B列はくだものが羅列されているだけで、A列とB列の関連は無いのだと思いますよ。

それにしても、毎日仕入れる素材は違うでしょうから、それを手入力するのは面倒そうに思いますね。別の列に、有無または在庫数を記入する方が楽に思うし、更には仕入れ日と賞味期限のデータがあれば、先に使用すべき素材から順に列挙する、とかも考えられそうですけどねぇ。
（???） 2017/01/23(月) 09:37

 １．Sheet2に下式を入力

 (1) G1セル =IF(H1="","",RANK(I:I,I:I))
 (2) H1セル =IF(OR(COUNTBLANK(B1:E1)=4,SUMPRODUCT(COUNTIF(Sheet1!A:B,B1:E1)+ISBLANK(B1:E1))<4),"",ROW())
 (3) I1セル =IF(H1<>"",RAND(),"")

 D1:I1 を下にコピー

 <結果図>
  行  ___A___  ___B___  ___C___  ___D___  _____E_____  _F_  _G_  _H_  ____I____
   1  プランA  人参     りんご                               3    1   0.544861 
   2  プランB  セロリ   みかん                               2    2   0.878354 
   3  プランC  里芋     いちご   人参     じゃがいも                          
   4  プランD  セロリ   いちご   ぶどう                      1    4   0.879273

 ２．Sheet1に下式を入力
 (1) D1セル =COUNT(Sheet2!H:H)&"件"

 (2) D2セル =IF(E2="","",ROW()-1)
 (3) E2セル =IF(SUBSTITUTE(D$1,"件","")-ROW(A1)<0,"",INDEX(Sheet2!A:A,VLOOKUP(SMALL(Sheet2!G:G,ROW(A1)),Sheet2!G:H,2,FALSE)))

 D2:E2 を下にコピー

 <結果図>
  行  ___A___  ___B___  _C_  _D_  ____E____
   1  野菜     果物          3件  プラン名 
   2  玉ねぎ   みかん          1  プランD  
   3  人参     ぶどう          2  プランB  
   4  セロリ   いちご          3  プランA  
   5  ねぎ     りんご

（半平太） 2017/01/23(月) 09:38

???さん>>
解説ありがとうございます。逆に考えておりました。お恥ずかしい・・・。
シート1の中身でプランを作っていくということですね。
失礼致しました。

（pooh） 2017/01/23(月) 09:49

Sub main()

    Dim dic As Object, c As Range, r As Range
    Set dic = CreateObject("scripting.dictionary")
    Sheets("Sheet1").Range("E:E").ClearContents
    Set r = Sheets("Sheet1").Range("E1")
    For Each c In Sheets("Sheet1").Range("A:B").Cells.SpecialCells(xlCellTypeConstants)
    dic(c.Value) = True
    Next c
    For Each c In Sheets("Sheet2").Range("B:E").Cells.SpecialCells(xlCellTypeConstants)
    If dic(c.Value) = False Then dic(c.Offset(, 1 - 1 * c.Column).Value) = True
    Next c
    For Each c In Sheets("Sheet2").Range("A:A").Cells.SpecialCells(xlCellTypeConstants)
    If dic(c.Value) = False Then r.Value = Format(Rnd * 1000, "000") & c.Value: Set r = r.Offset(1)
    Next c
    Sheets("Sheet1").Range("E:E").Sort Key1:=Range("E1")
    For Each c In Sheets("Sheet1").Range("E:E").Cells.SpecialCells(xlCellTypeConstants)
    c.Value = Mid(c.Value, 4)
    Next c
End Sub
（mm） 2017/01/23(月) 09:53

こんにちは

Sub test1()

    Dim f1 As Range
    Dim f2 As Range
    Dim r1 As Range
    Dim r2 As Range
    Dim h  As Long
    Dim i  As Long
    Dim j  As Long
    Dim k  As Long
    Dim b As Boolean
    With Worksheets("Sheet2")
        Set r1 = Intersect(.UsedRange, .Range("A:E"))
        j = r1.Rows.Count
    End With
    With Worksheets("Sheet1")
        .Range("D:F").ClearContents
        Set r2 = Intersect(.UsedRange, .Range("A:B"))
    End With
    Application.ScreenUpdating = False
    k = 1
    For i = 1 To j
        b = True
        Set f1 = r2.Find(r1(i, 2), , xlValues, xlWhole)
        If Not f1 Is Nothing Then
            For h = 3 To 5
                If r1(i, h) <> "" Then
                    Set f2 = r2.Find(r1(i, h), , xlValues, xlWhole)
                    If f2 Is Nothing Then
                        b = False
                        Exit For
                    End If
                End If
            Next
        Else
            b = False
        End If
        If b = True Then
            Worksheets("Sheet1").Cells(k, "D") = k
            Worksheets("Sheet1").Cells(k, "E") = r1(i, 1)
            k = k + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

こんな感じも。

（ウッシ） 2017/01/23(月) 10:08

みなさまありがとうございます！

poohさま
材料は2つ使うものから4つ使うものまでさまざまでした。野菜名と果物名は仮のもので、実際は食材ではなく腐らないものでした。説明が足りず申し訳ありません。ありがとうございます。

???さま
ネットで調べて関数をいろいろと試したのですが、複数列と複数列を組み合わせた検索がうまくいかず、困っておりました。A列とB列を1列にまとめるということは全く思いつきませんでした。見る方にとりましてはカテゴリごとに分けてあることに意味がありましたので…エクセルにとっては無価値、ではっとしました。アドバイスいただきありがとうございます。

半平太さま
教えていただいた関数を打ち込みましたら理想通りの内容になりました！ありがとうございます！

mmさま
ActiveXコンポーネントはオブジェクトを作成できませんとでてしまいました。
お知恵お貸しいただきありがとうございます。

ウッシさま
教えていただいたマクロでも理想通りになりました！ありがとうございます！

毎日毎日この組み合わせのチェックに多大な時間を使っていたのですが、エクセルの知識があまりなく、お教えいただいて作業が格段に楽になりました。ほんとうにありがとうございます！
（nao） 2017/01/23(月) 17:13

コメント返信：

[ 一覧(最新更新順) ]

[[20170123033006]] 『複数条件の検索と結果の一覧』（nao） ページの最後に飛ぶ

[[20170123033006]]　『複数条件の検索と結果の一覧』（nao）　ページの最後に飛ぶ