Excel VBA finds out the maximum and minimum values of a column of time, and repeatedly pastes multiple values according to the actual situation

Problem scenario ：

As shown in the figure below , You need to press the time in the date table , Paste the copied content into the result table . Please note that the dates in the date table are repeated .

1） Find the maximum and minimum dates in a column , And calculate the number of days

Use CDate + min/max Find the biggest and smallest date
Because it needs to include the start date , such as 5 month 29 To 6 month 11 Japan , Include 29 There are altogether 14 God , Excluding 13 God .
So the number of days is date_start-date_end +1

Sub  The minimum date in the date array ()

    Dim date_start As Date, date_end As Date
    Dim t As Integer
    
        date_start = CDate(Application.WorksheetFunction.Min(Range("A2:A1048573")))
        date_end = CDate(Application.WorksheetFunction.Max(Range("A2:A1048573")))
        
        Cells(1, 1) = date_start
        Cells(1, 2) = date_end
        Cells(1, 3) = date_end - date_start + 1

End Sub

2） Output the date to different cells in order

Use For …Next Cyclic output
because Cells(i,j) in , Neither row nor column can be 0
So define t=1 to date_end - date_start+1
Assign values to each cell Cells(2, t) = date_start + t - 1, Because of the front t+1, So we need to reduce 1

Sub  Output each date ()

    Dim date_start As Date, date_end As Date
    Dim t As Integer
    Dim C As Long
    Dim d As Long

    
        date_start = CDate(Application.WorksheetFunction.Min(Range("A2:A1048573")))
        date_end = CDate(Application.WorksheetFunction.Max(Range("A2:A1048573")))
        
        Cells(1, 1) = date_start
        Cells(1, 2) = date_end
        Cells(1, 3) = date_end - date_start + 1
        
   For t = 1 To date_end - date_start + 1
           Cells(2, t) = date_start + t - 1
       Next t
End Sub

3） Copy content 、 Paste repeatedly

Application.ScreenUpdating = False Prevent window jitter

Sub  The final code ()
    Application.ScreenUpdating = False
    
    Dim date_start As Date, date_end As Date
    Dim t As Integer
    Dim C As Long
    Dim d As Long

    
        date_start = CDate(Application.WorksheetFunction.Min(Range("A2:A1048573")))
        date_end = CDate(Application.WorksheetFunction.Max(Range("A2:A1048573")))
        
        Cells(1, 1) = date_start
        Cells(1, 2) = date_end
        Cells(1, 3) = date_end - date_start + 1
        
    'copy bank acount info
        Range("D9:F11").Select
        Selection.Copy
        
        
   For t = 1 To date_end - date_start + 1
            '  Paste the copy to the last line 
            Range("I8").Select
            C = 1 + Range("I1048573").End(xlUp).Row
            Cells(C, 10).Select
            ActiveSheet.Paste
            
            ' to update A Column time 
            d = Range("J1048573").End(xlUp).Row ' Confirm the position of the last line 
        
            Range(Cells(C, 9), Cells(d, 9)) = date_start + t - 1
       Next t
    
    ' Finally, delete the updated data 
    Range("A9:A1048573").Select
    Selection.Delete Shift:=xlUp

End Sub

Results after operation ：