こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

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列に「在庫なし」が
入るようにしたいです。
すみません、いろろと調べてはいるのですが、ちょっとわからず、こちらに投稿しました。どなたか、わかる方教えていただければ幸いです。
よろしくお願いします。

投稿日時 - 2017-04-18 11:51:19

QNo.9318913

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(10)

ANo.10

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

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

投稿日時 - 2017-05-07 07:10:56

ANo.9

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

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

'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無しに、したいのですが


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

投稿日時 - 2017-04-24 13:19:57

補足

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

投稿日時 - 2017-04-25 15:31:16

ANo.8

>例えば、愛媛産のみかん4個消費であれば、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

投稿日時 - 2017-04-22 18:05:27

補足

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

投稿日時 - 2017-04-25 15:13:22

ANo.7

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

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

投稿日時 - 2017-04-21 20:19:21

補足

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

投稿日時 - 2017-04-25 15:10:53

ANo.6

>行数が多くなった時に、パフォーマンスが気になるんすね。
当方のPC(Intel Celeron プロセッサー 1005M 1.90GHz )で
1万行で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秒で処理できました。

投稿日時 - 2017-04-21 11:53:56

ANo.5

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 = "在庫なし"

投稿日時 - 2017-04-21 09:48:32

お礼

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

投稿日時 - 2017-04-21 11:02:22

ANo.4

質問の標題にひかれて覗いてみた。
だいぶん質問の標題と、中身的に、やることとは違うのではないか。
在庫管理とか受注管理システムの、簡易的な、まね事ではないか。
エクセルのVBAの初歩的なスキルで、できそうなやり方で考えてみた。
ーー
下記のように、データをすこし質問の例に増やした。
購入日果物産地数量値段在庫  在庫
2017/4/10りんご青森1100在庫なし
2017/4/10りんご青森21102
2017/4/10りんご青森11101
2017/4/10りんご青森11202
2017/4/10みかん愛媛33503
2017/4/10りんご青森11201
2017/4/10りんご長野21202
2017/4/12みかん静岡33501
2017/4/13みかん愛媛22402
2017/4/14りんご長野21201
2017/4/10りんご青森11301
2017/4/10りんご青森11401
2017/4/15りんご青森11001
ーー
標準モジュールに
Sub test01()
Dim r As Range
Dim cnt As Long
Set myrng = Range("A1:F20") '第1行目の見出し行も含める
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個販売したので在庫ー1
Cells(2, 6) = Cells(2, 6) - 1
'--在庫0なら「在庫なし」の表示
If Cells(2, 6) = 0 Then Cells(2, 6) = "在庫なし"
myrng.AutoFilter
End Sub
ーーー
中間での結果
購入日果物産地数量値段在庫 在庫
2017/4/10りんご青森11001
2017/4/10りんご青森21102
2017/4/10りんご青森11101
2017/4/10りんご青森11202
2017/4/10りんご青森11201
2017/4/10りんご青森11301
2017/4/10りんご青森11401
2017/4/15りんご青森11001
上記の、「'---データ第I行を選択」以下も実行して
myrng.AutoFilterで、フィルター・モードを元へ戻して
結果は
購入日果物産地数量値段在庫  在庫
2017/4/10りんご青森1100在庫なし
2017/4/10りんご青森21102
2017/4/10りんご青森11101
2017/4/10りんご青森11202
2017/4/10みかん愛媛33503
2017/4/10りんご青森11201
2017/4/10りんご長野21202
2017/4/12みかん静岡33501
2017/4/13みかん愛媛22402
2017/4/14りんご長野21201
2017/4/10りんご青森11301
2017/4/10りんご青森11401
2017/4/15りんご青森11001
ーー
質問説明について
普通は受注は1個とは限らず、不足するなどの場合の対処、購入日を
またがるロットから出荷などの場合のことがよくわからず、複雑になるので
適当にやった。
この部分は、複雑になるもんだいであるので、上記回答はいい加減のまま。
--
こういうのはエクセルでやるのは無理があるのと、危険を積んだSEが対処すべき問題で、こういう無料の質問コーナーに、ちょこっと質問して
回答で勉強するのは無理があると思う。出来合いのソフトや、SEに
相談すること。

投稿日時 - 2017-04-20 22:36:16

お礼

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

投稿日時 - 2017-04-21 10:56:03

ANo.3

と、いう事は
ですね

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

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

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

投稿日時 - 2017-04-18 19:02:05

ANo.2

あ!ご免なさい

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

では無く

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

でした
済みません。

投稿日時 - 2017-04-18 16:47:46

補足

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

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

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

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

投稿日時 - 2017-04-18 17:34:32

ANo.1

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

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

投稿日時 - 2017-04-18 16:46:19

あなたにオススメの質問