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 sdate As Date       '滞在者の滞在開始日
    Dim edate 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
    '集計開始日チェック
    If IsDate(ws1.Cells(1, "AG").Value) = False Then
        Call err_proc(ws1, ws1.Cells(1, "AG"), "日付不正")
    End If
    '集計終了日チェック
    If IsDate(ws1.Cells(2, "AG").Value) = False Then
        Call err_proc(ws1, ws1.Cells(2, "AG"), "日付不正")
    End If
    '集計開始日、集計終了日順序チェック
    If ws1.Cells(1, "AG").Value > ws1.Cells(2, "AG").Value Then
        Call err_proc(ws1, ws1.Cells(2, "AG"), "終了日順序不正")
    End If
    '集計開始日と集計終了日を設定する
    start_date = ws1.Cells(1, "AG").Value
    end_date = ws1.Cells(2, "AG").Value
    For row1 = 3 To lastRow
        '前泊の文字チェック
        If ws1.Cells(row1, "D").Value <> "" And ws1.Cells(row1, "D").Value <> "前泊" Then
            Call err_proc(ws1, ws1.Cells(row1, "D"), "前泊以外の文字")
        End If
        '出発日チェック
        If ws1.Cells(row1, "E").Value <> "" And IsDate(ws1.Cells(row1, "E").Value) = False Then
            Call err_proc(ws1, ws1.Cells(row1, "E"), "日付不正")
        End If
        '帰宅日チェック
        If ws1.Cells(row1, "F").Value <> "" And IsDate(ws1.Cells(row1, "F").Value) = False Then
            Call err_proc(ws1, ws1.Cells(row1, "F"), "日付不正")
        End If
        '出発日<帰宅日であることのチェック
        If ws1.Cells(row1, "E").Value <> "" And ws1.Cells(row1, "F").Value <> "" Then
            If ws1.Cells(row1, "E").Value >= ws1.Cells(row1, "F").Value Then
                Call err_proc(ws1, ws1.Cells(row1, "F"), "日付順序不正")
            End If
        End If
    Next
    '集計結果クリア
    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
    '滞在者の滞在期間を設定
    For row1 = 3 To lastRow
        '出発日と帰宅日が共に設定されていれば、人数をカウントする
        If ws1.Cells(row1, "E").Value <> "" And ws1.Cells(row1, "F").Value Then
            sdate = ws1.Cells(row1, "E").Value
            edate = ws1.Cells(row1, "F").Value
            '前泊なら翌日からカウントする
            If ws1.Cells(row1, "D").Value = "前泊" Then
                sdate = sdate + 1
            End If
            '滞在開始日～滞在終了日まで繰り返す
            For wdate = sdate To edate
                '当日が集計開始～集計終了日の範囲内であればカウントする
                If wdate >= start_date And wdate <= end_date Then
                    '集計結果の行番号を算出する
                    row2 = wdate - start_date + 2
                    '算出した行に１加算する
                    ws2.Cells(row2, "B").Value = ws2.Cells(row2, "B").Value + 1
                End If
            Next
        End If
    Next
    MsgBox ("完了")
End Sub
'エラー処理
Private Sub err_proc(ByRef ws As Worksheet, ByRef rg As Range, ByVal msg As String)
    ws.Activate
    rg.Select
    MsgBox (msg)
    End
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOa7nuWcqOS6uuaVsOmbhuioiCgpCiAgICBEaW0gd3MxIEFzIFdvcmtzaGVldCAgICAn5rue5Zyo5LqI5a6aCiAgICBEaW0gd3MyIEFzIFdvcmtzaGVldCAgICAn6ZuG6KiI57WQ5p6cCiAgICBEaW0gbGFzdFJvdyBBcyBMb25nCiAgICBEaW0gcm93MSBBcyBMb25nICAgICAgICAn5rue5Zyo5LqI5a6a44Gu6KGM55Wq5Y+3CiAgICBEaW0gcm93MiBBcyBMb25nICAgICAgICAn6ZuG6KiI57WQ5p6c44Gu6KGM55Wq5Y+3CiAgICBEaW0gc3RhcnRfZGF0ZSBBcyBEYXRlICAn6ZuG6KiI6ZaL5aeL5pelCiAgICBEaW0gZW5kX2RhdGUgQXMgRGF0ZSAgICAn6ZuG6KiI57WC5LqG5pelCiAgICBEaW0gc2RhdGUgQXMgRGF0ZSAgICAgICAn5rue5Zyo6ICF44Gu5rue5Zyo6ZaL5aeL5pelCiAgICBEaW0gZWRhdGUgQXMgRGF0ZSAgICAgICAn5rue5Zyo6ICF44Gu5rue5Zyo57WC5LqG5pelCiAgICBEaW0gd2RhdGUgQXMgRGF0ZQogICAgU2V0IHdzMSA9IFdvcmtzaGVldHMoIua7nuWcqOS6iOWumiIpCiAgICBTZXQgd3MyID0gV29ya3NoZWV0cygi6ZuG6KiI57WQ5p6cIikKICAgIGxhc3RSb3cgPSB3czEuQ2VsbHMoUm93cy5jb3VudCwgIkMiKS5FbmQoeGxVcCkuUm93ICAgICAgJ0PliJfmnIDntYLooYzlj5blvpcKICAgIElmIGxhc3RSb3cgPCAzIFRoZW4KICAgICAgICBNc2dCb3ggKCLmu57lnKjogIXjgarjgZciKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgICfpm4boqIjplovlp4vml6Xjg4Hjgqfjg4Pjgq8KICAgIElmIElzRGF0ZSh3czEuQ2VsbHMoMSwgIkFHIikuVmFsdWUpID0gRmFsc2UgVGhlbgogICAgICAgIENhbGwgZXJyX3Byb2Mod3MxLCB3czEuQ2VsbHMoMSwgIkFHIiksICLml6Xku5jkuI3mraMiKQogICAgRW5kIElmCiAgICAn6ZuG6KiI57WC5LqG5pel44OB44Kn44OD44KvCiAgICBJZiBJc0RhdGUod3MxLkNlbGxzKDIsICJBRyIpLlZhbHVlKSA9IEZhbHNlIFRoZW4KICAgICAgICBDYWxsIGVycl9wcm9jKHdzMSwgd3MxLkNlbGxzKDIsICJBRyIpLCAi5pel5LuY5LiN5q2jIikKICAgIEVuZCBJZgogICAgJ+mbhuioiOmWi+Wni+aXpeOAgembhuioiOe1guS6huaXpemghuW6j+ODgeOCp+ODg+OCrwogICAgSWYgd3MxLkNlbGxzKDEsICJBRyIpLlZhbHVlID4gd3MxLkNlbGxzKDIsICJBRyIpLlZhbHVlIFRoZW4KICAgICAgICBDYWxsIGVycl9wcm9jKHdzMSwgd3MxLkNlbGxzKDIsICJBRyIpLCAi57WC5LqG5pel6aCG5bqP5LiN5q2jIikKICAgIEVuZCBJZgogICAgJ+mbhuioiOmWi+Wni+aXpeOBqOmbhuioiOe1guS6huaXpeOCkuioreWumuOBmeOCiwogICAgc3RhcnRfZGF0ZSA9IHdzMS5DZWxscygxLCAiQUciKS5WYWx1ZQogICAgZW5kX2RhdGUgPSB3czEuQ2VsbHMoMiwgIkFHIikuVmFsdWUKICAgIEZvciByb3cxID0gMyBUbyBsYXN0Um93CiAgICAgICAgJ+WJjeaziuOBruaWh+Wtl+ODgeOCp+ODg+OCrwogICAgICAgIElmIHdzMS5DZWxscyhyb3cxLCAiRCIpLlZhbHVlIDw+ICIiIEFuZCB3czEuQ2VsbHMocm93MSwgIkQiKS5WYWx1ZSA8PiAi5YmN5rOKIiBUaGVuCiAgICAgICAgICAgIENhbGwgZXJyX3Byb2Mod3MxLCB3czEuQ2VsbHMocm93MSwgIkQiKSwgIuWJjeaziuS7peWkluOBruaWh+WtlyIpCiAgICAgICAgRW5kIElmCiAgICAgICAgJ+WHuueZuuaXpeODgeOCp+ODg+OCrwogICAgICAgIElmIHdzMS5DZWxscyhyb3cxLCAiRSIpLlZhbHVlIDw+ICIiIEFuZCBJc0RhdGUod3MxLkNlbGxzKHJvdzEsICJFIikuVmFsdWUpID0gRmFsc2UgVGhlbgogICAgICAgICAgICBDYWxsIGVycl9wcm9jKHdzMSwgd3MxLkNlbGxzKHJvdzEsICJFIiksICLml6Xku5jkuI3mraMiKQogICAgICAgIEVuZCBJZgogICAgICAgICfluLDlroXml6Xjg4Hjgqfjg4Pjgq8KICAgICAgICBJZiB3czEuQ2VsbHMocm93MSwgIkYiKS5WYWx1ZSA8PiAiIiBBbmQgSXNEYXRlKHdzMS5DZWxscyhyb3cxLCAiRiIpLlZhbHVlKSA9IEZhbHNlIFRoZW4KICAgICAgICAgICAgQ2FsbCBlcnJfcHJvYyh3czEsIHdzMS5DZWxscyhyb3cxLCAiRiIpLCAi5pel5LuY5LiN5q2jIikKICAgICAgICBFbmQgSWYKICAgICAgICAn5Ye655m65pelPOW4sOWuheaXpeOBp+OBguOCi+OBk+OBqOOBruODgeOCp+ODg+OCrwogICAgICAgIElmIHdzMS5DZWxscyhyb3cxLCAiRSIpLlZhbHVlIDw+ICIiIEFuZCB3czEuQ2VsbHMocm93MSwgIkYiKS5WYWx1ZSA8PiAiIiBUaGVuCiAgICAgICAgICAgIElmIHdzMS5DZWxscyhyb3cxLCAiRSIpLlZhbHVlID49IHdzMS5DZWxscyhyb3cxLCAiRiIpLlZhbHVlIFRoZW4KICAgICAgICAgICAgICAgIENhbGwgZXJyX3Byb2Mod3MxLCB3czEuQ2VsbHMocm93MSwgIkYiKSwgIuaXpeS7mOmghuW6j+S4jeatoyIpCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgJ+mbhuioiOe1kOaenOOCr+ODquOCogogICAgd3MyLkNlbGxzLkNsZWFyQ29udGVudHMKICAgIHdzMi5DZWxscygxLCAiQSIpLlZhbHVlID0gIuaXpeS7mCIKICAgIHdzMi5DZWxscygxLCAiQiIpLlZhbHVlID0gIuS6uuaVsCIKICAgICfpm4boqIjplovlp4vml6XvvZ7pm4boqIjntYLkuobml6XoqK3lrpoKICAgIHJvdzIgPSAyCiAgICBGb3Igd2RhdGUgPSBzdGFydF9kYXRlIFRvIGVuZF9kYXRlCiAgICAgICAgd3MyLkNlbGxzKHJvdzIsICJBIikuVmFsdWUgPSB3ZGF0ZQogICAgICAgIHdzMi5DZWxscyhyb3cyLCAiQiIpLlZhbHVlID0gMAogICAgICAgIHJvdzIgPSByb3cyICsgMQogICAgTmV4dAogICAgJ+a7nuWcqOiAheOBrua7nuWcqOacn+mWk+OCkuioreWumgogICAgRm9yIHJvdzEgPSAzIFRvIGxhc3RSb3cKICAgICAgICAn5Ye655m65pel44Go5biw5a6F5pel44GM5YWx44Gr6Kit5a6a44GV44KM44Gm44GE44KM44Gw44CB5Lq65pWw44KS44Kr44Km44Oz44OI44GZ44KLCiAgICAgICAgSWYgd3MxLkNlbGxzKHJvdzEsICJFIikuVmFsdWUgPD4gIiIgQW5kIHdzMS5DZWxscyhyb3cxLCAiRiIpLlZhbHVlIFRoZW4KICAgICAgICAgICAgc2RhdGUgPSB3czEuQ2VsbHMocm93MSwgIkUiKS5WYWx1ZQogICAgICAgICAgICBlZGF0ZSA9IHdzMS5DZWxscyhyb3cxLCAiRiIpLlZhbHVlCiAgICAgICAgICAgICfliY3ms4rjgarjgonnv4zml6XjgYvjgonjgqvjgqbjg7Pjg4jjgZnjgosKICAgICAgICAgICAgSWYgd3MxLkNlbGxzKHJvdzEsICJEIikuVmFsdWUgPSAi5YmN5rOKIiBUaGVuCiAgICAgICAgICAgICAgICBzZGF0ZSA9IHNkYXRlICsgMQogICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgJ+a7nuWcqOmWi+Wni+aXpe+9nua7nuWcqOe1guS6huaXpeOBvuOBp+e5sOOCiui/lOOBmQogICAgICAgICAgICBGb3Igd2RhdGUgPSBzZGF0ZSBUbyBlZGF0ZQogICAgICAgICAgICAgICAgJ+W9k+aXpeOBjOmbhuioiOmWi+Wni++9numbhuioiOe1guS6huaXpeOBruevhOWbsuWGheOBp+OBguOCjOOBsOOCq+OCpuODs+ODiOOBmeOCiwogICAgICAgICAgICAgICAgSWYgd2RhdGUgPj0gc3RhcnRfZGF0ZSBBbmQgd2RhdGUgPD0gZW5kX2RhdGUgVGhlbgogICAgICAgICAgICAgICAgICAgICfpm4boqIjntZDmnpzjga7ooYznlarlj7fjgpLnrpflh7rjgZnjgosKICAgICAgICAgICAgICAgICAgICByb3cyID0gd2RhdGUgLSBzdGFydF9kYXRlICsgMgogICAgICAgICAgICAgICAgICAgICfnrpflh7rjgZfjgZ/ooYzjgavvvJHliqDnrpfjgZnjgosKICAgICAgICAgICAgICAgICAgICB3czIuQ2VsbHMocm93MiwgIkIiKS5WYWx1ZSA9IHdzMi5DZWxscyhyb3cyLCAiQiIpLlZhbHVlICsgMQogICAgICAgICAgICAgICAgRW5kIElmCiAgICAgICAgICAgIE5leHQKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgIE1zZ0JveCAoIuWujOS6hiIpCkVuZCBTdWIKJ+OCqOODqeODvOWHpueQhgpQcml2YXRlIFN1YiBlcnJfcHJvYyhCeVJlZiB3cyBBcyBXb3Jrc2hlZXQsIEJ5UmVmIHJnIEFzIFJhbmdlLCBCeVZhbCBtc2cgQXMgU3RyaW5nKQogICAgd3MuQWN0aXZhdGUKICAgIHJnLlNlbGVjdAogICAgTXNnQm94IChtc2cpCiAgICBFbmQKRW5kIFN1Ygo=