Excel VBA找出一列时间的最大最小值，并根据实际重复粘贴多个数值

问题场景：

如下图所示，需要按日期表里所出现的时间，将复制内容粘贴到结果表里。需要注意日期表里面的日期有重复。

1）找出一列数中的最大和最小日期, 并求出天数

使用CDate + min/max 找出最大最小的日期
因为需要包括起始日，比如5月29到6月11日，包括29号一共有14天，不包括则13天。
所以天数为date_start-date_end +1

Sub 日期数组中的最小日期()

    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）将日期按顺序输出到不同单元格里

使用For …Next 循环输出
由于Cells(i,j) 中，行和列都不可以为0
所以定义t=1 to date_end - date_start+1
每个单元格赋值Cells(2, t) = date_start + t - 1， 由于前面t+1，所以需要再减1

Sub 输出每个日期()

    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）复制内容、重复粘贴

Application.ScreenUpdating = False 防止窗口抖动

Sub 最终代码()
    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
            ' 将复制内容粘贴到最后一行
            Range("I8").Select
            C = 1 + Range("I1048573").End(xlUp).Row
            Cells(C, 10).Select
            ActiveSheet.Paste
            
            '更新A列时间
            d = Range("J1048573").End(xlUp).Row '确认最后一行的位置
        
            Range(Cells(C, 9), Cells(d, 9)) = date_start + t - 1
       Next t
    
    '最后删除更新的数据
    Range("A9:A1048573").Select
    Selection.Delete Shift:=xlUp

End Sub

运行后结果：