Excel VBAにおける複数条件での検索方法

質問

以下のように、Excelシートがあって
このExcelシートで以下の条件で検索、その結果を返すVBAを作りたいのですが、悩んでいます。
　　検索条件　果物：りんご
　　　　　　 産地：青森　
　　　　　　　複数ある時は、購入日が一番古いものを選ぶ。
　　　　　　　更に複数ある時は、値段の安いものを選ぶ。
　　　⇒行番号を返す
　　これで、1つの行が選択できたら、そのF列に「在庫なし」を挿入する。

　　　A列　　　　B列　　C列　　D列　　E列　　F列
1行　購入日　　　果物　　産地　　数量　値段　　在庫
2行　2017/4/10　りんご　　青森　　2 　　110
3行　2017/4/10　みかん　　愛媛　　3 　　350
4行　2017/4/10　りんご　　青森　　1 　　100
5行　2017/4/10　りんご　　長野　　2 　　120
6行　2017/4/12　みかん　　静岡　　3 　　350
7行　2017/4/13　みかん　　愛媛　　2 　　240
8行　2017/4/14　りんご　　長野　　2 　　120
9行　2017/4/15　りんご　　青森　　1 　　100

結果としては、上から4行目のリンゴのF列に「在庫なし」が
入るようにしたいです。
すみません、いろろと調べてはいるのですが、ちょっとわからず、こちらに投稿しました。どなたか、わかる方教えていただければ幸いです。
よろしくお願いします。

回答No.10

Nouble

此って
関数で、実現しても
構わない、話し
ですよね？

在庫無しが、入る
では無く
其処に、表示が
出れば、良い
なら
出来るの、ですが
如何ですか？

回答No.9

Nouble

済みません
未だ、デバッグ中
なの、ですか

お待たせしている、ので
中間報告と，して
現在の、記載内容を
報告します。

'Type セル範囲
' 行先頭 As Long
' 行終端 As Long
' 列先頭 As Long
' 列終端 As Long
'End Type

Type 最小値形式
日 As Date
価格 As Long
End Type

Const 日 As Long = 1
Const 実 As Long = 2
Const 場所 As Long = 3
Const 価格 As Long = 5
Option Base 1
Option Explicit

Function 多項検索(ByVal 検索範囲 As String, ByVal 果物 As String, ByVal 産地 As String) As Long
Dim カウンタ1 As Long, 最小値 As 最小値形式, 対象行 As Variant, ランゲ1 As Range, ランゲ2 As Range
Dim Temp1 As Variant, Temp2 As Variant, Temp3 As Variant, Temp4 As Long, LaRow As Variant
'Dim 対象範囲 As セル範囲

' Let 対象範囲.行先頭 = Range(検索範囲).Cells(1, 1).Row
' Let 対象範囲.行終端 = Range(検索範囲).Rows.Count + 対象範囲.行先頭 - 1
' Let 対象範囲.列先頭 = Range(検索範囲).Cells(1, 1).Row
' Let 対象範囲.列終端 = Range(検索範囲).Columns.Count + 対象範囲.列先頭 - 1
Set ランゲ1 = Range(検索範囲).Range(Cells(1, 実), Cells(Range(検索範囲).Rows.Count, 実))
Set ランゲ2 = Range(検索範囲).Range(Cells(1, 場所), Cells(Range(検索範囲).Rows.Count, 場所))
Set LaRow = [ROW(ランゲ1)]
Set Temp1 = [(ランゲ1.Value=果物)+0]
Set Temp2 = [(ランゲ2.Value=産地)+0]
Set Temp1 = Temp1 * Temp2
Let Temp4 = CLng([SUMPRODUCT(Temp1)]) '対等項目数算出
Set Temp1 = Temp1 * LaRow
If Temp4 < 2 _
Then
Let 多項検索 = CLng([max(Temp1]) '該当項目数が0:0を　同数が1:行No.を　返す
Else
Set Temp2 = [(ランゲ1.Value<>果物)+0]
Set Temp3 = [(ランゲ2.Value<>産地)+0]
Set Temp2 = [Sign(Temp2 + Temp3) * 9999]
Set Temp1 = Temp1 + Temp2
Set ランゲ1 = Range(Cells(1, 日), Cells(Temp4, 日))
Set Temp2 = [ROW(ランゲ1)]
Set 対象行 = [Small((Temp1　&　","　&　Temp2　&　"))"] '日付比較対象行No.取得
Let 最小値.日 = Range(検索範囲).Cells(対象行(1), 日).Value
For カウンタ1 = 2 To Temp4 Step 1 '日付最小値、取得
If Range(検索範囲).Cells(対象行(カウンタ1), 日).Value < 最小値.日 _
Then
Let 最小値.日 = Range(検索範囲).Cells(対象行(カウンタ1), 日).Value
End If
Next
Set ランゲ1 = Range(検索範囲).Range(Cells(1, 日), Cells(Rows, 日))
Set Temp2 = [(ランゲ1.Value=最小値.日)+0]
Set Temp1 = Temp2 * LaRow
Let Temp4 = [SUMPRODUCT(Temp2)] '日付一致行数取得
If Temp4 < 2 _
Then
Let 多項検索 = CLng([max(Temp1)]) '該当項目数が0:0を　同数が1:行No.を　返す
Else
Set Temp2 = [(ランゲ1.Value<>最小値.日)＊9999]
Set Temp1 = [(Temp1 + Temp2)]
Set Temp2 = [ROW(ランゲ1)]
Let 対象行 = [Small(Temp1,Temp2)] '価格比較対象行No.取得
Let 最小値.価格 = Range(検索範囲).Cells(対象行(1), 価格).Value '価格比較初期値
For カウンタ1 = 2 To Temp4 Step 1 '価格最小値、及び記載行No.、取得
Set ランゲ2 = Range(検索範囲).Cells(対象行(カウンタ1), 日)
If ランゲ2.Value < 最小値.価格 _
Then
Let 最小値.価格 = ランゲ2.Value
Let Temp4 = ランゲ2.Row
End If
Next
Let 多項検索 = Temp4 '最上行価格最安記載行No.を返す
End If
End If

'メモリー解放
' Erace 対象範囲
Set 対象行 = Null
Set ランゲ1 = Null
Set ランゲ2 = Null
Set Temp1 = Null
Set Temp2 = Null
Set Temp3 = Null
End Function

Sub main()
Dim ダミー As Long
Let ダミー = 多項検索("A2:E9", "リンゴ", "青森")
End Sub

出来れば
Evaluate("OFFSET(…
等と、して
Loop無しに、したいのですが
…

お待たせ、しており
済みません

補足

Noubleさま
ありがとうございます。
やっと、自身もやっとこのロジックに着手しそうな感じなので、
私も返信が遅れまして、申し訳ありません。
Noubleさま、他の皆さまの回答を読ませていただき、着手します。
お礼コメントまで、しばしお時間をください。
本当にありがとうございます。

回答No.8

watabe007

>例えば、愛媛産のみかん４個消費であれば、3行目は、在庫なし。
>7行目は在庫残1個として、管理をしようとしています。
Sub Test3()
　Dim i As Long
　Dim 果物 As String, 産地 As String
　Dim 購入日 As Date, 値段 As Long
　Dim 行 As Long, v As Variant
　Dim 数量 As Long, LastRow As Long

　果物 = "みかん"
　産地 = "愛媛"
　数量 = 4
　LastRow = Cells(Rows.Count, "A").End(xlUp).Row
　Range("F2:F" & LastRow).ClearContents
　Do Until 数量 = 0
　　v = Range("A2:F" & LastRow).Value
　　For i = LBound(v) To UBound(v)
　　　If v(i, 2) = 果物 And v(i, 3) = 産地 And v(i, 6) <> "在庫なし" Then
　　　　If 行 = 0 Then
　　　　　購入日 = v(i, 1)
　　　　　値段 = v(i, 5)
　　　　　行 = i
　　　　ElseIf 購入日 > v(i, 1) Then
　　　　　購入日 = v(i, 1)
　　　　　値段 = v(i, 5)
　　　　　行 = i
　　　　ElseIf 購入日 = v(i, 1) And 値段 > v(i, 5) Then
　　　　　購入日 = v(i, 1)
　　　　　値段 = v(i, 5)
　　　　　行 = i
　　　　End If
　　　End If
　　Next
　　If 行 = 0 Then
　　　Exit Do
　　ElseIf v(行, 4) = 数量 Then
　　　Cells(行 + 1, "F").Value = "在庫なし"
　　　数量 = 0
　　　Exit Do
　　ElseIf v(行, 4) > 数量 Then
　　　Cells(行 + 1, "F").Value = v(行, 4) - 数量
　　　数量 = 0
　　　Exit Do
　　ElseIf v(行, 4) < 数量 Then
　　　Cells(行 + 1, "F").Value = "在庫なし"
　　　数量 = 数量 - v(行, 4)
　　End If
　　行 = 0
　Loop
　If 数量 > 0 Then MsgBox 数量 & "個不足しています。"
End Sub

補足

回答ありがとうございます。
こちらについて、皆様の回答を読み理解しつつ、
PGを作成しています。
実際は、こちらに書いた内容よりも複雑なので、少しづつ読ませていただいております。
ありがとうございます。

回答No.7

Nouble

解答で
なく、
また、
未だ、出来て
いない、中
此しか、言えません
済みません

今、少し
開けて、おいて
頂いて、構いませんか？

補足

ありがとうございます。
こちらにまだ、コメントをかけずすみません。
こちらに質問させていただたいた処理前のPGを作成中でまだ、こちらの処理まで追いついていないです。
また、私自身VB初心者のため、皆さんの書いていただいた、内容を理解しながら少しづつ進めています。
ありがとうございます。

回答No.6

watabe007

>行数が多くなった時に、パフォーマンスが気になるんすね。
当方のPC(Intel Celeron プロセッサー 1005M 1.90GHz )で
１万行で0.25秒で終わりましたが、それでも問題なら配列を使って
Sub Test2()
Dim i As Long
Dim 果物 As String, 産地 As String
Dim 購入日 As Date, 値段 As Long
Dim 行 As Long, v As Variant
Dim Start As Single

Start = Timer
果物 = "りんご"
産地 = "青森"
v = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = LBound(v) To UBound(v)
If v(i, 2) = 果物 And v(i, 3) = 産地 Then
If 行 = 0 Then
購入日 = v(i, 1)
値段 = v(i, 5)
行 = i
ElseIf 購入日 > v(i, 1) Then
購入日 = v(i, 1)
値段 = v(i, 5)
行 = i
ElseIf 購入日 = v(i, 1) And 値段 > v(i, 5) Then
購入日 = v(i, 1)
値段 = v(i, 5)
行 = i
End If
End If
Next
Cells(行 + 1, "F").Value = "在庫なし"
MsgBox "処理時間は " & Timer - Start & "秒です"
End Sub
0.02秒で処理できました。

回答No.5

watabe007

Sub Test()
Dim i As Long
Dim 果物 As String, 産地 As String
Dim 購入日 As Date, 値段 As Long
Dim 行 As Long

果物 = "りんご"
産地 = "青森"

For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, "B").Value = 果物 And Cells(i, "C").Value = 産地 Then
If 行 = 0 Then
購入日 = Cells(i, "A").Value
値段 = Cells(i, "E").Value
行 = i
ElseIf 購入日 > Cells(i, "A").Value Then
購入日 = Cells(i, "A").Value
値段 = Cells(i, "E").Value
行 = i
ElseIf 購入日 = Cells(i, "A").Value And 値段 > Cells(i, "E").Value Then
購入日 = Cells(i, "A").Value
値段 = Cells(i, "E").Value
行 = i
End If
End If
Next
Cells(行, "F").Value = "在庫なし"

お礼

watabe007さん
回答ありがとうございます。
シンプルですね。やっぱりこのやり方がいちばんいいのですかね。
行数が多くなった時に、パフォーマンスが気になるんすね。
参考にさせていただきます。
ありがとうございます。

回答No.4

imogasi

質問の標題にひかれて覗いてみた。
だいぶん質問の標題と、中身的に、やることとは違うのではないか。
在庫管理とか受注管理システムの、簡易的な、まね事ではないか。
エクセルのＶＢＡの初歩的なスキルで、できそうなやり方で考えてみた。
ーー
下記のように、データをすこし質問の例に増やした。
購入日 果物 産地 数量 値段 在庫　　在庫
2017/4/10 りんご 青森 1 100 在庫なし
2017/4/10 りんご 青森 2 110 2
2017/4/10 りんご 青森 1 110 1
2017/4/10 りんご 青森 1 120 2
2017/4/10 みかん 愛媛 3 350 3
2017/4/10 りんご 青森 1 120 1
2017/4/10 りんご 長野 2 120 2
2017/4/12 みかん 静岡 3 350 1
2017/4/13 みかん 愛媛 2 240 2
2017/4/14 りんご 長野 2 120 1
2017/4/10 りんご 青森 1 130 1
2017/4/10 りんご 青森 1 140 1
2017/4/15 りんご 青森 1 100 1
ーー
標準モジュールに
Sub test01()
Dim r As Range
Dim cnt As Long
Set myrng = Range("A1:F20") '第１行目の見出し行も含める
myrng.AutoFilter
'Exit Subオートフィルター確認用
'抽出条件
myrng.AutoFilter Field:=2, Criteria1:="りんご"
myrng.AutoFilter Field:=3, Criteria1:="青森"
'--日付列でソート　見出し行を含めない
Range("A2:F20").Sort Key1:=Worksheets("Sheet1").Columns(1), order1:=xlAscending, Key2:=Worksheets("Sheet1").Columns(5), order1:=xlAscending
'---価格列でソート　日付は保存されるはず
'Range("A2:F20").Sort Key1:=Worksheets("Sheet1").Columns(5), order1:=xlAscending
'---データ第I行を選択
Rows(2).Select
'--今回1個販売したので在庫ー１
Cells(2, 6) = Cells(2, 6) - 1
'--在庫０なら「在庫なし」の表示
If Cells(2, 6) = 0 Then Cells(2, 6) = "在庫なし"
myrng.AutoFilter
End Sub
ーーー
中間での結果
購入日 果物 産地 数量 値段 在庫　在庫
2017/4/10 りんご 青森 1 100 １
2017/4/10 りんご 青森 2 110 2
2017/4/10 りんご 青森 1 110 1
2017/4/10 りんご 青森 1 120 2
2017/4/10 りんご 青森 1 120 1
2017/4/10 りんご 青森 1 130 1
2017/4/10 りんご 青森 1 140 1
2017/4/15 りんご 青森 1 100 1
上記の、「'---データ第I行を選択」以下も実行して
myrng.AutoFilterで、フィルター・モードを元へ戻して
結果は
購入日 果物 産地 数量 値段 在庫　　在庫
2017/4/10 りんご 青森 1 100 在庫なし
2017/4/10 りんご 青森 2 110 2
2017/4/10 りんご 青森 1 110 1
2017/4/10 りんご 青森 1 120 2
2017/4/10 みかん 愛媛 3 350 3
2017/4/10 りんご 青森 1 120 1
2017/4/10 りんご 長野 2 120 2
2017/4/12 みかん 静岡 3 350 1
2017/4/13 みかん 愛媛 2 240 2
2017/4/14 りんご 長野 2 120 1
2017/4/10 りんご 青森 1 130 1
2017/4/10 りんご 青森 1 140 1
2017/4/15 りんご 青森 1 100 1
ーー
質問説明について
普通は受注は１個とは限らず、不足するなどの場合の対処、購入日を
またがるロットから出荷などの場合のことがよくわからず、複雑になるので
適当にやった。
この部分は、複雑になるもんだいであるので、上記回答はいい加減のまま。
－－
こういうのはエクセルでやるのは無理があるのと、危険を積んだＳＥが対処すべき問題で、こういう無料の質問コーナーに、ちょこっと質問して
回答で勉強するのは無理があると思う。出来合いのソフトや、ＳＥに
相談すること。

お礼

回答ありがとうございます。
imogasiさんのやり方は、マクロの記録でも確認できそうですね。
実際のところ、おっしゃるとおり、ここに書いた内容と、やりたいことは異なります。ただ、Excelだと、どのように検索をすればよいかがわからず、にいたので、投稿しました。
おっしゃるとおり、引き当て方法はもっとパターンがあり複雑になってくると思います。その部分まではさすがにここには書ききれないため、基本部分のみを質問させていただきました。
　ありがとうございます。

回答No.3

Nouble

と、いう事は
ですね

適合行が
あれば、行数
無ければ、０
を、
各々、返す
其のような
Long型の、function
で、構わない

渡す値と、しては
シートは、ActiveSheet
検索範囲　As　String
果物　　　As　String
産地　　　As　String
位で…
と、言う事ですね？

出来るかは、別として
考えて、みますね。

回答No.2

Nouble

あ！ご免なさい

青森産リンゴが
4つ、売れた時
青森産リンゴが
1つ、売れた時

では無く

青森産リンゴが
4つ、売れた時
青森産リンゴが
2つ、売れた時

でした
済みません。

補足

補足の質問ありがとうございます。
はい。実際は、どれだけ使ったかの数量も関連するのですが、そこのロジックは自分でも考えることができるので、質問には、書きませんでした。

例えば、愛媛産のみかん４個消費であれば、3行目は、在庫なし。
7行目は在庫残1個として、管理をしようとしています。

その後、また消費があった場合は、7行目の在庫1つを消費して
次の新しい行のものを消費するようにロジックを組もうと思っています。

すべてここで質問するわけにはいかないので、自身がわからないところだけ、簡素化して、質問させていただきました。

回答No.1

Nouble

質問させてください
此、売れた数
削除しないの、ですか？

青森産リンゴが
4つ、売れた時
青森産リンゴが
1つ、売れた時
では、
挙動、変わりませんか？