Excel VBA 日付けでIF/Else仕訳

質問

図のようなリストがあります。
「発売日」の日付けを判断するVBAを教えてください。

・オレンジ色のセルと「発売日」のE列は固定で移動しません。
・データの最終行は未定（表による、ここでは17行目、No.13が最後のデータ）
・データのある右端の列も未定（表による）
・表のタイトル行（No. シリアル・・・）は固定（4行目）

このようなシートに対して、次のような操作ができるVBAのコードを教えてください。

1. 「発売日」のE列を調べ、"G1"の"EOL最終日"と比較し、こお日"以前"の行は、
　右端に"EOL"と入力する
（EOLとは「End Of Life」で、部品サプライヤーが部品供給を終わったことを意味します）
2. "G1"の日付けの翌日から"G2"の日付け（当日含む）までの期間にある部品は現行品のため、"現行品"と入力する
3.E列でどちらにも該当しない入力、空欄、ゴミ入力などは”N/A”と入力する（これはElseでよい）

表の右端は現在の表ではF列の「備考」列ですが、表によっては誰かが列を増やしている可能性があるため、上記の入力は列の右の空いている未使用列に入力したい。

日付け形式で入力された列の、If / Elseif/ Else判定の仕方がわからずこまっています。

よろしくお願いします。

回答No.3

kkkkkm · ベストアンサー

以下でいかがですか

Sub Example()
Dim MyLastRow As Long, MyLastColumn As Long
Dim i As Long

MyLastColumn = Cells(4, Columns.Count).End(xlToLeft).Column
MyLastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 5 To MyLastRow
If Not IsDate(Cells(i, "E").Text) Then
Cells(i, MyLastColumn + 1).Value = "N/A"
ElseIf Cells(i, "E").Value2 <= Cells(1, "G").Value2 Then
Cells(i, MyLastColumn + 1).Value = "EOL"
ElseIf Cells(i, "E").Value2 > Cells(1, "G").Value2 And Cells(i, "E").Value2 <= Cells(2, "G").Value2 Then
Cells(i, MyLastColumn + 1).Value = "現行品"
Else
Cells(i, MyLastColumn + 1).Value = "N/A"
End If
Next
End Sub

お礼

ありがとうございました。
実際の処理はこのコードをベースに手を加えて使用させていただきました。
くせがないコードで、理解しやすかったです。

回答No.4

kagakusuki

回答No.1です。

　もし判定をIf / Elseif/ Elseでやる場合には、最初に
If 「日付ではない場合」Or「現行品の最終日よりも後の場合」 Then
という構文使って”N/A”となる場合の判定と処理を先に行ってしまい、続けて
Elseif 「EOL最終日以前」 Then
という構文使って”EOL”となる場合の判定と処理を行い、最後に
Else
を使って上記のどれにも該当しない場合、即ち"現行品"となる
「日付である場合」で尚且つ「EOL最終日以降～現行品の最終日以前の場合」
の処理を行う様にすれば良い訳です。

Sub QNo9222033_Excel_VBA_日付けでIF_Else仕訳_別法()

Const SearchColumn = "E" '発売日が入力されているの列の列番号
Const ItemRow = 4 '表中で項目名が入力されている行の行番号

Dim InputColumn As Long, LastRow As Long, i As Long, buf As Variant, temp As Variant _
, DateCell(1) As Range, OutputString(2) As String, LastDate(1) As Variant

Set DateCell(0) = Range("G1") 'EOLの最終日が入力されているセル
Set DateCell(1) = Range("G2") '現行品の最終日が入力されているセル
OutputString(0) = "N/A" 'EOLでも現行品でもない場合に書き込む値
OutputString(1) = "EOL" 'EOLの場合に書き込む値
OutputString(2) = "現行品" '現行品の場合に書き込む値

For i = 0 To 1
LastDate(i) = DateCell(i).Value
If Not IsDate(LastDate(i)) Then
MsgBox DateCell(i).Address(False, False) & "セルに日付が入力されていません。" _
& vbCrLf & "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If
Next i
InputColumn = Cells(ItemRow, Columns.Count).End(xlToLeft).column + 1
LastRow = Range(SearchColumn & Rows.Count).End(xlUp).row
If InputColumn <= Columns(SearchColumn).column Or LastRow <= ItemRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For i = ItemRow + 1 To LastRow
temp = Range(SearchColumn & i).Value
If Not IsDate(temp) Or temp > LastDate(1) Then
buf = OutputString(0)
ElseIf temp <= LastDate(0) Then
buf = OutputString(1)
Else
buf = OutputString(2)
End If
Cells(i, InputColumn).Value = buf
Next i

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

ありがとうございます。
また類似した質問をすると思いますが、よろしくお願いいたさいます。
いつもありがとうございます。

回答No.2

ushi2015

こんにちは
IF/Elseに拘らなければ、
Sub test()
　　Dim c As Long
　　c = WorksheetFunction.CountA(Rows(4))
　　With Range("A5", Range("A" & Rows.Count).End(xlUp)).Offset(, c)
　　　　.Formula = "=IF(OR($E5>$G$2,$E5=""""),""N/A"",IF($E5<=$G$1,""EOL"",""現行品""))"
　　　　.Value = .Value
　　End With
End Sub
とかでも。

お礼

ありがとうございます。
これは短くていいですね。
勉強課題として保管しておきます。

回答No.1

kagakusuki

一例としては次の様なVBAマクロとなります。

Sub QNo9222033_Excel_VBA_日付けでIF_Else仕訳()

Const SearchColumn = "E" '発売日が入力されているの列の列番号
Const ItemRow = 4 '表中で項目名が入力されている行の行番号

Dim InputColumn As Long, LastRow As Long, i As Long, buf As Variant, temp As Variant _
, DateCell(1) As Range, OutputString(2) As String, LastDate(1) As Variant

Set DateCell(0) = Range("G1") 'EOLの最終日が入力されているセル
Set DateCell(1) = Range("G2") '現行品の最終日が入力されているセル
OutputString(0) = "N/A" 'EOLでも現行品でもない場合に書き込む値
OutputString(1) = "EOL" 'EOLの場合に書き込む値
OutputString(2) = "現行品" '現行品の場合に書き込む値

For i = 0 To 1
LastDate(i) = DateCell(i).Value
If Not IsDate(LastDate(i)) Then
MsgBox DateCell(i).Address(False, False) & "セルに日付が入力されていません。" _
& vbCrLf & "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If
Next i
InputColumn = Cells(ItemRow, Columns.Count).End(xlToLeft).column + 1
LastRow = Range(SearchColumn & Rows.Count).End(xlUp).row
If InputColumn <= Columns(SearchColumn).column Or LastRow <= ItemRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For i = ItemRow + 1 To LastRow
temp = Range(SearchColumn & i).Value
If Not IsDate(temp) Then temp = ""
Select Case temp
Case Is <= LastDate(0)
buf = OutputString(1)
Case LastDate(0) + 1 To LastDate(1)
buf = OutputString(2)
Case Else
buf = OutputString(0)
End Select
Cells(i, InputColumn).Value = buf
Next i

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

ありがとうございます。
Set DateCell(0) ,OutputString(0)のところが、わたしの理解が申込し進まないと応用が難しそうです。
MsgBoxは取り入れさせていただきました。