touyakucheck2.vba

option VBASupport 1
sub Check
With Sheets("Sheet1").UsedRange
    s1Row = .Rows(.Rows.Count).Row
End With
CrDate = cdate("1900/01/01") 'ダミーの初期値
PrDate = cdate("1900/01/01") 'ダミーの初期値
Worksheets("Sheet1").Select
'1行目からデータ行最終行+1行まで行毎に
for i=1 to s1Row+1
    'A列の値に"年"が有ったら
    if instr(Cells(i,1).text, "年") Then
        'CrDateが初期値以外なら投薬実績をチェックする（初回は実績がないから飛ばす）
        if CrDate<>cdate("1900/01/01") Then
            PrDate=CrDate
            ChkKaisu CrDate, Jisseki
        end if
        CrDate=Cells(i,1).value 'CrDataにA列の値を代入
        'PrDataが初期値でなく且つPrDateとCrDateの差が1でないなら未入力日があるのでその分をエラー出力
        if PrDate<>cdate("1900/01/01") and  PrDate+1 <> CrDate then
            for j=1 to datediff("d",PrDate, CrDate)-1
                ErrOut Format((PrDate+j),"m月d日") & " 無入力"
            next j
        end if
        Jisseki=""
    'A列の値に":"が有ったらB列のセル内容をJissekiに追加する
    elseif instr(Cells(i,1).text, ":") Then
        Jisseki=JIsseki & Cells(i,2)
    '最終行になったら最終日の投薬実績をチェック
    elseif i=s1Row+1 Then
        ChkKaisu CrDate, Jisseki
    end if
Next i
Worksheets("Sheet2").Select
msgbox "完了しました"
end sub

sub ChkKaisu(ByVal CrDate as date , ByVal Jisseki as string)
periods=array("朝","昼","夕")
for each period in periods
        if len(Jisseki)-len(Replace(Jisseki,period,""))<>1 then
        ErrOut Format((CrDate),"m月d日") & " " & period & len(Jisseki)-len(Replace(Jisseki,period,"")) & "回"
    end if
next period
end sub

sub ErrOut(Arg as string)
With Sheets("Sheet2").UsedRange
    s2Row = .Rows(.Rows.Count).Row
End With
Worksheets("Sheet2").Cells(s2Row+1,1)=Arg
end sub