エクセルで重複データの日付から6か月以上を見つける

質問

お世話になります。

添付の表のようにA列に製造日、B列にLOT Noを入れる表があります。
原料Aを製造したら品質検査をします。
その原料を後日使う時に、最近検査した日付から6か月い以上経過していいたらその原料AのLOTは使用する前に再度品質検査する必要があります。

具体的には着色セルのLOTは繰り返し使用されており、黄色のABC123は前回試験をした日から6か月以内なのでOK、橙色のセルのLOTABC129は2回目はOKですが、3回目の使用時には検査課必要です。
このように★を表示させる式、もしくはVBAをご教示いただきたく。

昔ここ？で教えてもらって試行錯誤して★を追加し、書式設定でLOT Noに色を付けることで解決した記憶があるので下記のような式の復元になりましたが★の列はなくても検査が必要なLOT No（前回の検査から半年以上経過LOT）に色が付けばOKです。

=IF(DATEDIF(SUMPRODUCT(MAX(A$2:A2*(C$2:C2=C3)*(D$2:D2="★"))),A3,"M")>=6,"★","")

宜しくお願いします。
（今、貼り付けた表を見たら少し矛盾がありますがご容赦下さい）

回答No.4

HohoPapa · ベストアンサー

LotNoの埋まる列のうち、埋まらない行は空欄ではなく
半角のマイナスだったんですね。
見落としていました。
この部分を修正したコードが後記です。

★やＯＫの埋まる列がどの列かは関係しません。
★やＯＫを埋めたい列のセルたちに、
=MyChk(A:A,B:B)といった関数を埋めて使います。
この関数の
第一引数「A:A」が日付の埋まった列で、
第二引数「B:B」がLotNoの埋まった列です。

Option Explicit

Function MyChk(DateRng As Range, LotRng As Range) As String

　Const SRow = 14　'データ開始行

　Dim BCol As Long
　Dim DCol As Long
　Dim i As Long
　Dim HitDate As Date
　Dim ThisRow As Long

　DCol = DateRng.Column
　BCol = LotRng.Column

　ThisRow = Application.ThisCell.Row
　i = ThisRow - 1

　'LotNoが埋まっていない場合は空欄を返す
　If Cells(ThisRow, BCol).Value = "-" Then
　　MyChk = ""
　　Exit Function
　End If

　Do
　　If i < SRow Then Exit Do
　　If Cells(i, BCol).Value = Cells(ThisRow, BCol).Value Then
　　　HitDate = Cells(i, DCol).Value
　　　Exit Do
　　End If
　　i = i - 1
　Loop

　If Cells(ThisRow, DCol).Value - HitDate > 180 Then
　　MyChk = "★"
　Else
　　MyChk = "OK"
　End If

End Function

お礼

こんばんは

今日は忙しく時間がなかったので今確認しました。
全く問題なく、全く期待通りに動きました。
セルの指定をコードではなく式（＝MyChk（A:A,B:B））で指定できるとは思いませんでした。

因みに当方赴任以来「空白セル厳禁！」を徹底しましたので「-」が入っているのですが、★の列も空白「””」はやめて「-」に変えて一発解決でした。

いつもながら当方の推理ゲームみたいな質問（6か月？180日？）に一番欲しい内容のご回答に感服します。
本件は品質検査後の経時変化の確認なので日付ではなく日数（180日）の意図でした。

回答No.3

tanakanono

せめてバーコード管理とかされないんでしょうか？
それともプログラミング練習課題でしょうか？

生産管理で使用されているなら、データが消えないようにバックアップとか、入力ミスされないようにとか、故意に変なデータを書かれないようにとか、エクセルでもいいと思いますが、いろいろ対策するのが当たり前だと思います。

お礼

ご回答ありがとうございました。

特殊なケースなので自主管理です。
本来製造後の使用期間（製品のライフ）が切れたら廃棄ですので、再検査はあり得ないルールんあっていますので。

回答No.2

HohoPapa

#1です。
こっちのほうがスマートと思いますので
差し替えます。

Option Explicit

Function MyChk(DateRng As Range, LotRng As Range) As String

　Const SRow = 14　'データ開始行

　Dim BCol As Long
　Dim DCol As Long
　Dim i As Long
　Dim HitDate As Date
　Dim ThisRow As Long

　DCol = DateRng.Column
　BCol = LotRng.Column

　ThisRow = Application.ThisCell.Row
　i = ThisRow - 1

　If Cells(ThisRow, BCol).Value = "" Then
　　MyChk = ""
　　Exit Function
　End If

　Do
　　If i < SRow Then Exit Do
　　If Cells(i, BCol).Value = Cells(ThisRow, BCol).Value Then
　　　HitDate = Cells(i, DCol).Value
　　　Exit Do
　　End If
　　i = i - 1
　Loop

　If Cells(ThisRow, DCol).Value - HitDate > 180 Then
　　MyChk = "★"
　Else
　　MyChk = "OK"
　End If

End Function

お礼

今回も期待通りの結果となりました。
いつもながら当方の意図と、いつもの追加要求に完全回答に感謝です。
今後ともよろしくお願いいたします。

補足

HohoPapaーさん
お久しぶりです。
最近はこれまで教わったVBAの新規シートへの展開と機能の追加がメインになって質問する機会が減ったのですが久しぶりの質問で再開できて何となく非常にうれしいです。

さて、今回のコードは当方には難しいようで添付図を参考にダミーシートで同じレイアウトにしてみたら期待通りに動くことを確認したのですが。。。。（いつもながら1発回答！）

しかし、
１．実際には★の列はMやL列のシートがありこの列を指定しているコードが分からず。（適当にいじりましたが当たらず）

２．更に原料LOTのB列のセルは空白ではなく「－」が入っているので目的セル以外の全てのセルに「OK」が入ります。（これはこれでも良いのですが出来れば添付図のように必要なセルのみに「OK」「★」にしたく。

毎度の追加要求で恐縮ですが急ぎませんので宜しくお願い致します。

回答No.1

HohoPapa

>6か月以上
これが１８０日以上ということでよければ
後記関数でいけるものと思いますが

日数ではなく
例えば　4/10から10/10が、6か月と1日と判断するのであれば
8/30を起点に過去6か月の場合、2/30がないので、何月何日をもって、
6か月以上前と判断するでしょうか？
日付や経過日数を扱う場合、
この辺りの扱いを厳密に定義する必要があります。

Option Explicit

Function MyChk(LotRng As Range, DmyRng As Range) As String

　Const SRow = 14　'データ開始行

　Dim BCol As Long
　Dim DCol As Long
　Dim i As Long
　Dim HitDate As Date
　Dim ThisRow As Long

　DCol = DmyRng.Column
　BCol = LotRng.Column

　ThisRow = Application.ThisCell.Row
　i = ThisRow - 1

　Do
　　If i < SRow Then Exit Do
　　If Cells(i, BCol).Value = LotRng.Value Then
　　　HitDate = Cells(i, DCol).Value
　　　Exit Do
　　End If
　　i = i - 1
　Loop

　If Cells(ThisRow, DCol).Value - HitDate > 180 Then
　　MyChk = "★"
　Else
　　MyChk = "OK"
　End If

End Function