日付を連続で入力するマクロ

インプットボックスに開始日と

終了日を入力すると

A列に開始日から終了日までの日付が入力されるマクロ

コード

Sub 連続日付入力()
    Dim startDate As Date
    Dim endDate As Date
    Dim currentCell As Range
    
    ' 開始日と終了日を入力してください
    startDate = DateValue(InputBox("開始日を【yyyy/mm/dd】の形式で入力してください"))
    endDate = DateValue(InputBox("終了日を【yyyy/mm/dd】の形式で入力してください"))
    
    ' 開始日から終了日までの日付をA列に入力
    Set currentCell = Range("A1")
    Do While startDate <= endDate
        currentCell.Value = startDate
        Set currentCell = currentCell.Offset(1, 0)
        startDate = startDate + 1
    Loop
End Sub

なんに使うのこれ？と思うでしょ。
これだけなら手入力の方が早いもん。
だけど、応用するとすごい便利。

応用編

リストにあるそれぞれの開始日、終了日に沿って

各人のシートを作るマクロ
これをCSVにするとシステムの取り込みとかに使える。

コード

Sub 日付連続入力()
    Dim sourcews As Worksheet
    Dim lastrow As Long
    Dim i As Long
    Dim nameStr As String
    Dim number As Long
    Dim startDate As Date
    Dim endDate As Date
    Dim newws As Worksheet
    Dim currentCell As Range
    
    'リストのワークシートを設定
    Set sourcews = ActiveSheet
    
    ' 最終行を取得
    lastrow = sourcews.Range("A1").CurrentRegion.Rows.Count
    
    ' 繰り返し
    For i = 2 To lastrow
        
        ' 入力データを指定
        With sourcews
            nameStr = .Cells(i, 2)
            number = .Cells(i, 3)
            startDate = .Cells(i, 4)
            endDate = .Cells(i, 5)
        End With
    
        ' 新しいシートを追加
        Set newws = Worksheets.Add
    
        ' 新しいシートにデータを入力'A1を始点にした場合
        Set currentCell = newws.Range("A1")
            Do While startDate <= endDate
                currentCell.Value = startDate
                currentCell.Offset(0, 1) = nameStr
                currentCell.Offset(0, 2) = number
                Set currentCell = currentCell.Offset(1, 0)
                startDate = startDate + 1
        Loop
        
        ' シートの名前を変更
        newws.name = nameStr
    
    Next

End Sub

注意点

• リストのシートをアクティブにして動作
• セル番号などは要編集