Option Explicit
 
Public Sub 滞在人数集計()
    Dim ws1 As Worksheet    '滞在予定
    Dim ws2 As Worksheet    '集計結果
    Dim lastRow As Long
    Dim row1 As Long        '滞在予定の行番号
    Dim row2 As Long        '集計結果の行番号
    Dim start_date As Date  '集計開始日
    Dim end_date As Date    '集計終了日
    Dim wdate As Date
    Set ws1 = Worksheets("滞在予定")
    Set ws2 = Worksheets("集計結果")
    lastRow = ws1.Cells(Rows.count, "C").End(xlUp).Row      'C列最終行取得
    If lastRow < 3 Then
        MsgBox ("滞在者なし")
        Exit Sub
    End If
    '集計開始日／終了日をチェックし、開始日／終了日を取得する
    Call check_shukei_date(ws1.Cells(1, "AG"), ws1.Cells(2, "AG"), start_date, end_date)
    '集計結果クリア
    ws2.Cells.ClearContents
    ws2.Cells(1, "A").Value = "日付"
    ws2.Cells(1, "B").Value = "人数"
    '集計開始日～集計終了日設定
    row2 = 2
    For wdate = start_date To end_date
        ws2.Cells(row2, "A").Value = wdate
        ws2.Cells(row2, "B").Value = 0
        row2 = row2 + 1
    Next
    '3行～最終行まで繰り返す
    For row1 = 3 To lastRow
        '滞在人数設定
        Call set_taizai_ninzu(ws1, row1, start_date, end_date, ws2)
    Next
    MsgBox ("完了")
End Sub
'集計日チェック
Private Sub check_shukei_date(ByRef rng_s As Range, ByRef rng_e As Range, ByRef s_d As Date, ByRef e_d As Date)
    Call check_date(rng_s, False, "開始日")  '開始日チェック（空白の日付を許さない）
    Call check_date(rng_e, False, "終了日")  '終了日チェック（空白の日付を許さない）
    If rng_s.Value > rng_e.Value Then
        Call abort(rng_e, "終了日順序不正")
    End If
    s_d = rng_s.Value
    e_d = rng_e.Value
End Sub
 
'滞在人数設定
Private Sub set_taizai_ninzu(ByRef ws1 As Worksheet, ByVal row1 As Long, ByVal s_d As Date, ByVal e_d As Date, ByRef ws2 As Worksheet)
    Dim sdate As Date       '滞在者の滞在開始日
    Dim edate As Date       '滞在者の滞在終了日
    Dim wdate As Date
    Dim row2 As Long        '集計結果の行番号
    '前泊の文字チェック
    If ws1.Cells(row1, "D").Value <> "" And ws1.Cells(row1, "D").Value <> "前泊" Then
        Call abort(ws1.Cells(row1, "D"), "前泊以外の文字")
    End If
    Call check_date(ws1.Cells(row1, "E"), True, "出発日")  '出発日チェック（空白の日付を許す）
    Call check_date(ws1.Cells(row1, "F"), True, "帰宅日")  '出発日チェック（空白の日付を許す）
    sdate = ws1.Cells(row1, "E").Value
    edate = ws1.Cells(row1, "F").Value
    '出発日、帰宅日の何れかが空白ならカウントしない
    If sdate = 0 Or edate = 0 Then Exit Sub
    '出発日<帰宅日であることのチェック
    If sdate >= edate Then
        Call abort(ws1.Cells(row1, "F"), "帰宅日順序不正")
    End If
    '前泊なら翌日からカウントする
    If ws1.Cells(row1, "D").Value = "前泊" Then
        sdate = sdate + 1
    End If
    '滞在開始日～滞在終了日まで繰り返す
    For wdate = sdate To edate
        '当日が集計開始～集計終了日の範囲内であればカウントする
        If wdate >= s_d And wdate <= e_d Then
            '集計結果の行番号を算出する
            row2 = wdate - s_d + 2
            '算出した行に１加算する
            ws2.Cells(row2, "B").Value = ws2.Cells(row2, "B").Value + 1
        End If
    Next
End Sub
'日付チェック
Private Sub check_date(ByRef rng As Range, ByVal allow_space As Boolean, ByVal base_msg As String)
    If rng.Value = "" Then
        If allow_space = True Then Exit Sub
        Call abort(rng, base_msg & "が空白")
    Else
        If IsDate(rng.Value) = False Then
            Call abort(rng, base_msg & "が不正")
        End If
    End If
End Sub
'アボート処理
Private Sub abort(ByRef rng As Range, ByVal msg As String)
    rng.Parent.Activate
    rng.Select
    MsgBox (msg)
    End
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOa7nuWcqOS6uuaVsOmbhuioiCgpCiAgICBEaW0gd3MxIEFzIFdvcmtzaGVldCAgICAn5rue5Zyo5LqI5a6aCiAgICBEaW0gd3MyIEFzIFdvcmtzaGVldCAgICAn6ZuG6KiI57WQ5p6cCiAgICBEaW0gbGFzdFJvdyBBcyBMb25nCiAgICBEaW0gcm93MSBBcyBMb25nICAgICAgICAn5rue5Zyo5LqI5a6a44Gu6KGM55Wq5Y+3CiAgICBEaW0gcm93MiBBcyBMb25nICAgICAgICAn6ZuG6KiI57WQ5p6c44Gu6KGM55Wq5Y+3CiAgICBEaW0gc3RhcnRfZGF0ZSBBcyBEYXRlICAn6ZuG6KiI6ZaL5aeL5pelCiAgICBEaW0gZW5kX2RhdGUgQXMgRGF0ZSAgICAn6ZuG6KiI57WC5LqG5pelCiAgICBEaW0gd2RhdGUgQXMgRGF0ZQogICAgU2V0IHdzMSA9IFdvcmtzaGVldHMoIua7nuWcqOS6iOWumiIpCiAgICBTZXQgd3MyID0gV29ya3NoZWV0cygi6ZuG6KiI57WQ5p6cIikKICAgIGxhc3RSb3cgPSB3czEuQ2VsbHMoUm93cy5jb3VudCwgIkMiKS5FbmQoeGxVcCkuUm93ICAgICAgJ0PliJfmnIDntYLooYzlj5blvpcKICAgIElmIGxhc3RSb3cgPCAzIFRoZW4KICAgICAgICBNc2dCb3ggKCLmu57lnKjogIXjgarjgZciKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgICfpm4boqIjplovlp4vml6XvvI/ntYLkuobml6XjgpLjg4Hjgqfjg4Pjgq/jgZfjgIHplovlp4vml6XvvI/ntYLkuobml6XjgpLlj5blvpfjgZnjgosKICAgIENhbGwgY2hlY2tfc2h1a2VpX2RhdGUod3MxLkNlbGxzKDEsICJBRyIpLCB3czEuQ2VsbHMoMiwgIkFHIiksIHN0YXJ0X2RhdGUsIGVuZF9kYXRlKQogICAgJ+mbhuioiOe1kOaenOOCr+ODquOCogogICAgd3MyLkNlbGxzLkNsZWFyQ29udGVudHMKICAgIHdzMi5DZWxscygxLCAiQSIpLlZhbHVlID0gIuaXpeS7mCIKICAgIHdzMi5DZWxscygxLCAiQiIpLlZhbHVlID0gIuS6uuaVsCIKICAgICfpm4boqIjplovlp4vml6XvvZ7pm4boqIjntYLkuobml6XoqK3lrpoKICAgIHJvdzIgPSAyCiAgICBGb3Igd2RhdGUgPSBzdGFydF9kYXRlIFRvIGVuZF9kYXRlCiAgICAgICAgd3MyLkNlbGxzKHJvdzIsICJBIikuVmFsdWUgPSB3ZGF0ZQogICAgICAgIHdzMi5DZWxscyhyb3cyLCAiQiIpLlZhbHVlID0gMAogICAgICAgIHJvdzIgPSByb3cyICsgMQogICAgTmV4dAogICAgJzPooYzvvZ7mnIDntYLooYzjgb7jgafnubDjgorov5TjgZkKICAgIEZvciByb3cxID0gMyBUbyBsYXN0Um93CiAgICAgICAgJ+a7nuWcqOS6uuaVsOioreWumgogICAgICAgIENhbGwgc2V0X3RhaXphaV9uaW56dSh3czEsIHJvdzEsIHN0YXJ0X2RhdGUsIGVuZF9kYXRlLCB3czIpCiAgICBOZXh0CiAgICBNc2dCb3ggKCLlrozkuoYiKQpFbmQgU3ViCifpm4boqIjml6Xjg4Hjgqfjg4Pjgq8KUHJpdmF0ZSBTdWIgY2hlY2tfc2h1a2VpX2RhdGUoQnlSZWYgcm5nX3MgQXMgUmFuZ2UsIEJ5UmVmIHJuZ19lIEFzIFJhbmdlLCBCeVJlZiBzX2QgQXMgRGF0ZSwgQnlSZWYgZV9kIEFzIERhdGUpCiAgICBDYWxsIGNoZWNrX2RhdGUocm5nX3MsIEZhbHNlLCAi6ZaL5aeL5pelIikgICfplovlp4vml6Xjg4Hjgqfjg4Pjgq/vvIjnqbrnmb3jga7ml6Xku5jjgpLoqLHjgZXjgarjgYTvvIkKICAgIENhbGwgY2hlY2tfZGF0ZShybmdfZSwgRmFsc2UsICLntYLkuobml6UiKSAgJ+e1guS6huaXpeODgeOCp+ODg+OCr++8iOepuueZveOBruaXpeS7mOOCkuioseOBleOBquOBhO+8iQogICAgSWYgcm5nX3MuVmFsdWUgPiBybmdfZS5WYWx1ZSBUaGVuCiAgICAgICAgQ2FsbCBhYm9ydChybmdfZSwgIue1guS6huaXpemghuW6j+S4jeatoyIpCiAgICBFbmQgSWYKICAgIHNfZCA9IHJuZ19zLlZhbHVlCiAgICBlX2QgPSBybmdfZS5WYWx1ZQpFbmQgU3ViCgon5rue5Zyo5Lq65pWw6Kit5a6aClByaXZhdGUgU3ViIHNldF90YWl6YWlfbmluenUoQnlSZWYgd3MxIEFzIFdvcmtzaGVldCwgQnlWYWwgcm93MSBBcyBMb25nLCBCeVZhbCBzX2QgQXMgRGF0ZSwgQnlWYWwgZV9kIEFzIERhdGUsIEJ5UmVmIHdzMiBBcyBXb3Jrc2hlZXQpCiAgICBEaW0gc2RhdGUgQXMgRGF0ZSAgICAgICAn5rue5Zyo6ICF44Gu5rue5Zyo6ZaL5aeL5pelCiAgICBEaW0gZWRhdGUgQXMgRGF0ZSAgICAgICAn5rue5Zyo6ICF44Gu5rue5Zyo57WC5LqG5pelCiAgICBEaW0gd2RhdGUgQXMgRGF0ZQogICAgRGltIHJvdzIgQXMgTG9uZyAgICAgICAgJ+mbhuioiOe1kOaenOOBruihjOeVquWPtwogICAgJ+WJjeaziuOBruaWh+Wtl+ODgeOCp+ODg+OCrwogICAgSWYgd3MxLkNlbGxzKHJvdzEsICJEIikuVmFsdWUgPD4gIiIgQW5kIHdzMS5DZWxscyhyb3cxLCAiRCIpLlZhbHVlIDw+ICLliY3ms4oiIFRoZW4KICAgICAgICBDYWxsIGFib3J0KHdzMS5DZWxscyhyb3cxLCAiRCIpLCAi5YmN5rOK5Lul5aSW44Gu5paH5a2XIikKICAgIEVuZCBJZgogICAgQ2FsbCBjaGVja19kYXRlKHdzMS5DZWxscyhyb3cxLCAiRSIpLCBUcnVlLCAi5Ye655m65pelIikgICflh7rnmbrml6Xjg4Hjgqfjg4Pjgq/vvIjnqbrnmb3jga7ml6Xku5jjgpLoqLHjgZnvvIkKICAgIENhbGwgY2hlY2tfZGF0ZSh3czEuQ2VsbHMocm93MSwgIkYiKSwgVHJ1ZSwgIuW4sOWuheaXpSIpICAn5Ye655m65pel44OB44Kn44OD44Kv77yI56m655m944Gu5pel5LuY44KS6Kix44GZ77yJCiAgICBzZGF0ZSA9IHdzMS5DZWxscyhyb3cxLCAiRSIpLlZhbHVlCiAgICBlZGF0ZSA9IHdzMS5DZWxscyhyb3cxLCAiRiIpLlZhbHVlCiAgICAn5Ye655m65pel44CB5biw5a6F5pel44Gu5L2V44KM44GL44GM56m655m944Gq44KJ44Kr44Km44Oz44OI44GX44Gq44GECiAgICBJZiBzZGF0ZSA9IDAgT3IgZWRhdGUgPSAwIFRoZW4gRXhpdCBTdWIKICAgICflh7rnmbrml6U85biw5a6F5pel44Gn44GC44KL44GT44Go44Gu44OB44Kn44OD44KvCiAgICBJZiBzZGF0ZSA+PSBlZGF0ZSBUaGVuCiAgICAgICAgQ2FsbCBhYm9ydCh3czEuQ2VsbHMocm93MSwgIkYiKSwgIuW4sOWuheaXpemghuW6j+S4jeatoyIpCiAgICBFbmQgSWYKICAgICfliY3ms4rjgarjgonnv4zml6XjgYvjgonjgqvjgqbjg7Pjg4jjgZnjgosKICAgIElmIHdzMS5DZWxscyhyb3cxLCAiRCIpLlZhbHVlID0gIuWJjeaziiIgVGhlbgogICAgICAgIHNkYXRlID0gc2RhdGUgKyAxCiAgICBFbmQgSWYKICAgICfmu57lnKjplovlp4vml6XvvZ7mu57lnKjntYLkuobml6Xjgb7jgafnubDjgorov5TjgZkKICAgIEZvciB3ZGF0ZSA9IHNkYXRlIFRvIGVkYXRlCiAgICAgICAgJ+W9k+aXpeOBjOmbhuioiOmWi+Wni++9numbhuioiOe1guS6huaXpeOBruevhOWbsuWGheOBp+OBguOCjOOBsOOCq+OCpuODs+ODiOOBmeOCiwogICAgICAgIElmIHdkYXRlID49IHNfZCBBbmQgd2RhdGUgPD0gZV9kIFRoZW4KICAgICAgICAgICAgJ+mbhuioiOe1kOaenOOBruihjOeVquWPt+OCkueul+WHuuOBmeOCiwogICAgICAgICAgICByb3cyID0gd2RhdGUgLSBzX2QgKyAyCiAgICAgICAgICAgICfnrpflh7rjgZfjgZ/ooYzjgavvvJHliqDnrpfjgZnjgosKICAgICAgICAgICAgd3MyLkNlbGxzKHJvdzIsICJCIikuVmFsdWUgPSB3czIuQ2VsbHMocm93MiwgIkIiKS5WYWx1ZSArIDEKICAgICAgICBFbmQgSWYKICAgIE5leHQKRW5kIFN1Ygon5pel5LuY44OB44Kn44OD44KvClByaXZhdGUgU3ViIGNoZWNrX2RhdGUoQnlSZWYgcm5nIEFzIFJhbmdlLCBCeVZhbCBhbGxvd19zcGFjZSBBcyBCb29sZWFuLCBCeVZhbCBiYXNlX21zZyBBcyBTdHJpbmcpCiAgICBJZiBybmcuVmFsdWUgPSAiIiBUaGVuCiAgICAgICAgSWYgYWxsb3dfc3BhY2UgPSBUcnVlIFRoZW4gRXhpdCBTdWIKICAgICAgICBDYWxsIGFib3J0KHJuZywgYmFzZV9tc2cgJiAi44GM56m655m9IikKICAgIEVsc2UKICAgICAgICBJZiBJc0RhdGUocm5nLlZhbHVlKSA9IEZhbHNlIFRoZW4KICAgICAgICAgICAgQ2FsbCBhYm9ydChybmcsIGJhc2VfbXNnICYgIuOBjOS4jeatoyIpCiAgICAgICAgRW5kIElmCiAgICBFbmQgSWYKRW5kIFN1Ygon44Ki44Oc44O844OI5Yem55CGClByaXZhdGUgU3ViIGFib3J0KEJ5UmVmIHJuZyBBcyBSYW5nZSwgQnlWYWwgbXNnIEFzIFN0cmluZykKICAgIHJuZy5QYXJlbnQuQWN0aXZhdGUKICAgIHJuZy5TZWxlY3QKICAgIE1zZ0JveCAobXNnKQogICAgRW5kCkVuZCBTdWIK