| 違反投稿 |
Option Explicit
Sub count()
Dim r As Long, LastRow As Long, FoundRow As Long
Dim d As Date
LastRow = Range("B1").End(xlDown).Row
For r = 1 To LastRow
Cells(r, 3).Value = DateAdd("d", 90, Cells(r, 2).Value)
Next
For r = 1 To LastRow
d = Cells(r, 3).Value
FoundRow = F_SearchRow(d)
If FoundRow = 0 Then
'見つからなかっら場合の処理を記述。
'常に見つかるように日付は余裕を持って記述した方が良いでしょう。
'本当は行の切れ目の日付判定が必要なのですが、単純に３日前を入れておきます。
Cells(r, 4).Value = DateAdd("d", -3, d)
Stop '←とりあえず、Stopをかけときます。
Else
Cells(r, 4).Value = F_3kkamae(FoundRow)
End If
Next
End Sub
Function F_SearchRow(d As Date) As Long
Dim r As Long
For r = 1 To Range("B1").End(xlDown).Row
If Cells(r, 2).Value = d Then
F_SearchRow = r
Exit Function
End If
Next
F_SearchRow = 0 '見つからなかったら0
End Function
Function F_3kkamae(FoundRow As Long) As Variant
Dim r As Long, ct As Integer
ct = 0
For r = (FoundRow - 1) To 1 Step -1
If Cells(r, 1).Value <> "注射" Then
ct = ct + 1
If ct = 3 Then
F_3kkamae = Cells(r, 2).Value
Exit Function
End If
End If
Next
F_3kkamae = "？？？"
End Function |
