こんなのではどうでしょうか?
まず、B列が終了の場合だけA列が2つの日付(期間)になっている場合です。
まず考え方としては、前月以前と来月以降だけが問題になるので、各処理中の日付はその月の1日として処理します。
例えば2009/7は2009/7/1、2009/3/12は2009/3/1、処理日の2009/8/10は2009/8/1とすると、単純な大小比較で処理できると思います。
また、期間の~は半角マイナスに変換してから処理します。
2009/7などはdatevalue("2009/7")とすると自動的に2009/7/1に変換してくれますが、datevalue("09/7")などは2009/9/7になってしまいます。
datevalue("09/7/1")とすれば2009/07/01になるので、その処理も入れました。
Sub sample()
Dim today As Date
Dim lastRow As Long
Dim r As Long
Dim val As String
Dim d() As String
Dim v As String
today = Date '処理日取得
today = DateSerial(Year(today), Month(today), 1) '処理日の月の1日に
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For r = lastRow To 1 Step -1
val = Range("A" & r).Value
val = Replace(val, "~", "-") '~を-"
'val = Replace(val, "-", "-") '必要なら全角マイナスを半角マイナスへ
'val = Replace(val, "ー", "-") '必要なら長音記号を半角マイナスへ
d = Split(val, "-") '-で分割
Select Case Range("B" & r).Value
Case "実施中"
If InStr(InStr(d(0), "/") + 1, d(0), "/") = 0 Then d(0) = d(0) & "/1" '年/月の場合に年/月/1にする処理(たぶんなくてもいい)
If DateSerial(Year(DateValue(d(0))), Month(DateValue(d(0))), 1) > today Then 'A列の日付の月の1日の日付が処理日の月の1日の日付より大きければ
Rows(r).Delete '削除
End If
Case "終了"
If InStr(InStr(d(1), "/") + 1, d(1), "/") = 0 Then d(1) = d(1) & "/1" '年/月の場合に年/月/1にする処理(たぶんなくてもいい)
If DateSerial(Year(DateValue(d(1))), Month(DateValue(d(1))), 1) < today Then 'A列の2番目の日付の月の1日の日付が処理日の月の1日の日付より大きければ
Rows(r).Delete '削除
End If
Case Else
MsgBox "データ異常"
Exit Sub
End Select
Next
End Sub
p.s.
DateSerialは便利な関数で、DateSerial(2009,12+1,1)とすると自動的に2010/01/01にしてくれます。
DateSerial(2009,1-2,1)は2008/11/01にしてくれます。
お礼
ありがとうございます! ためしてみます!