
以下のように、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列に「在庫なし」が
入るようにしたいです。
すみません、いろろと調べてはいるのですが、ちょっとわからず、こちらに投稿しました。どなたか、わかる方教えていただければ幸いです。
よろしくお願いします。
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
こんばんは。
以下は、手作業ですることを、マクロに写しただけのものです。
コードは細かいですが、仕組みは分かっていただけると思います。
H列 I列 J列 この3つの列の2行目に条件を書きます。
果物 産地 購入日
りんご 青森 2017/4/10
J列は、計算で出されています。自動的に数式が入ります。
J2: =DMIN(A1:F9,J1,H1:I2)
同列の時は、ふたつに「在庫なし」が入ります。
'//
Sub FindStocks()
Dim LastCell As Range
Dim Rng As Range
Dim VRng5 As Range '値段
Dim VRng1 As Range '未使用
Dim vMin As Long
Dim CritRange As Range
Dim c As Range
With ActiveSheet
Set CritRange = Range("H1:J2") '条件を入れる範囲
If .FilterMode Then
.Range("A1").AutoFilter
.Range("A1").AutoFilter
End If
'必ずフィルド名と合わせてください。
CritRange.Resize(1, 3).Value = Array("果物", "産地", "購入日")
For Each c In CritRange.Resize(1, 2)
If c.Offset(1).Value = "" Then
MsgBox c.Value & "の値を入れてください", vbExclamation
Exit Sub
End If
Next
Set LastCell = .Cells(Rows.Count, 1).End(xlUp).Offset(, 5)
Set Rng = .Range("A1", LastCell)
CritRange.Cells(2, 3).FormulaLocal = _
"=DMIN(" & Rng.Address & "," & CritRange.Cells(1, 3).Address & "," & CritRange.Resize(2, 2).Address & ")"
Rng.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=CritRange, Unique:=False
On Error Resume Next
'在庫なしを消す
Rng.Columns(6).Offset(1).SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0
Set VRng5 = Rng.Columns(5).SpecialCells(xlCellTypeVisible)
If Application.Subtotal(2, VRng5) = 1 Then
VRng5.Cells(VRng5.Cells.Count, 2).Value = "在庫なし"
Else
vMin = Application.Subtotal(5, VRng5)
For Each c In VRng5.Cells
If vMin = c.Value Then
c.Offset(, 1).Value = "在庫なし"
End If
Next
End If
.Range("A1").AutoFilter
.Range("A1").AutoFilter
.Range("A1").Select
End With
End Sub

No.1
- 回答日時:
Sub WK()
Dim HI As Date
Dim Sh As Worksheet
Set Sh = ActiveSheet
END1 = Sh.Range("A65536").End(xlUp).Row
HI = "9999/12/31"
KAKAKU = 99999999
行 = 0
For CNT = 2 To END1
If Sh.Range("B" & CNT).Value = "りんご" And Sh.Range("C" & CNT).Value = "青森" Then
If Sh.Range("A" & CNT).Value < HI Then
HI = Sh.Range("A" & CNT).Value
KAKAKU = Sh.Range("E" & CNT).Value
行 = CNT
ElseIf Sh.Range("A" & CNT).Value = HI Then
If Sh.Range("E" & CNT).Value < KAKAKU Then
KAKAKU = Sh.Range("E" & CNT).Value
行 = CNT
End If
End If
End If
Next CNT
If 行 > 0 Then
Sh.Range("F" & 行).Value = "在庫なし"
End If
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) ExcelのVLOOKUP関数 7 2022/08/23 06:46
- Excel(エクセル) VLOOKUP が機能しない、その原因は何 ? 8 2022/10/19 12:06
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
- Excel(エクセル) Excel_マクロ_複数のシートのVLOOKUPで表示された#N/A以外に色付けをしたいです 1 2023/02/16 22:37
- Visual Basic(VBA) 3つの条件を指定してVBAで行を削除したい 条件1:分類1が重複 条件2:分類2が重複 条件3:個数 6 2022/06/24 11:07
- Excel(エクセル) 【Excel】指定のセル内容を基に別シートのセルを検索して選択する【VBA】 1 2022/06/16 16:16
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 3 2022/06/12 11:17
- Excel(エクセル) Excelの列から検索して該当する行を別シートに転記するVBA 2 2022/12/20 09:35
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 2 2022/06/25 22:42
- Visual Basic(VBA) Sheet1をフィルターで「りんご」を抽出し、Sheet2へ地域を貼り付ける下記マクロを変更して S 2 2022/12/11 03:01
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelで、あるセルの値に応じて...
-
B列の最終行までA列をオート...
-
URLのリンク切れをマクロを使っ...
-
Cellsのかっこの中はどっちが行...
-
vba 2つの条件が一致したら...
-
Worksheets メソッドは失敗しま...
-
VBAのFind関数で結合セルを検索...
-
IIF関数の使い方
-
【VBA】2つのシートの値を比較...
-
エクセル 2つの表の並べ替え
-
VBA 何かしら文字が入っていたら
-
VBAを使って検索したセルをコピ...
-
オートフィルタをマクロで作成...
-
Changeイベントでの複数セルの...
-
複数csvを横に追加していくマク...
-
VBAで、離れた複数の列に対して...
-
データグリッドビューの一番最...
-
エクセル アクティブセルから...
-
SUM関数の範囲を変数を代入して...
-
VBAで指定範囲内の空白セルを左...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Cellsのかっこの中はどっちが行...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
IIF関数の使い方
-
VBA 何かしら文字が入っていたら
-
VBAのFind関数で結合セルを検索...
-
【VBA】2つのシートの値を比較...
-
文字列の結合を空白行まで実行
-
Changeイベントでの複数セルの...
-
URLのリンク切れをマクロを使っ...
-
VBAで指定範囲内の空白セルを左...
-
【Excel VBA】 B列に特定の文字...
-
VBAを使って検索したセルをコピ...
-
VBAで、特定の文字より後を削除...
-
エクセル 2つの表の並べ替え
-
データグリッドビューの一番最...
-
rowsとcolsの意味
-
VBAでのリスト不一致抽出について
おすすめ情報