touyakucheck.vba

sub Check
With Sheets("Sheet1").UsedRange
    s1Row = .Rows(.Rows.Count).Row
End With
timings=array("朝","昼","夕")
CrDate=cdate("1900/01/01")
PrDate=cdate("1900/01/01")
Worksheets("Sheet1").Select
for i=1 to s1Row
    if instr(Cells(i,1).text, "年") Then
        if CrDate<>cdate("1900/01/01") Then
            PrDate=CrDate
            for each timing in timings
                if len(Jisseki)-len(Replace(Jisseki,timing,""))<>1 then
                    ErrOut Format((CrDate),"m月d日") &" " & timing & len(Jisseki)-len(Replace(Jisseki,timing,"")) & "回"
                end if
            next timing
        end if
        CrDate=Cells(i,1).value
        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=""
    elseif instr(Cells(i,1).text, ":") Then
        Jisseki=JIsseki & Cells(i,2)
    end if
Next i
Worksheets("Sheet2").Select
msgbox "完了しました"
end sub

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