在 excel vba 中的两个日期之间循环

Question

我是 Excel vba 的新手，只是希望有一个代码来填充给定日期之间的日期并将其打印到新列

我的日期是

我希望有一个如下所示的日期顺序

1/04/2020
1/05/2020
1/06/2020
**23/06/2020** Month break here
1/07/2020
1/08/2020
1/09/2020
**26/09/2020** month break here
1/10/2020
**15/10/2020** month break here
1/11/2020

到目前为止，我找到了 Min 和 Max 并使用了这段代码。我真的无法从任何地方获得任何帮助

Sub MAX_FIND()
Min_Date as date
Max_date as Date

Min_date = Application.WorksheetFunction.Min(Range("b7:b12"))
Range("c3") = DateAdd("m", -1, Min_date)'

Max_date = Application.WorksheetFunction.Max(Range("b7:b12"))
add_max = DateAdd("m", 1, Max_date)
Range("D3") = DateSerial(Year(add_max), Month(add_max), 1)

    End Sub

非常感谢..谢谢

Answer 1

以下代码根据您的输入创建所需的日期顺序。

我们使用ArrayList（System.Collection对象的一个成员）来

创建一个唯一的日期列表（删除重复项）
两种方式排序，轻松搞定获取第一个和最后一个日期的方法
将第一个日期、最后一个日期和任何中间缺失的第一个月日期添加到列表中
然后我们将其转移到一个常规数组中，对不是当月第一天的现有日期进行一些特殊处理（如您在示例中所示）：

Option Explicit
Sub Dts()
    Dim arrDts As Object
    Dim v, w, dt, I As Long
    Dim dtStart As Date, dtEnd As Date
    
Set arrDts = CreateObject("System.Collections.ArrayList")

'get unique list of dts
With Worksheets("sheet1")
    v = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
    For Each w In v
        If Not arrDts.contains(w) Then arrDts.Add w
    Next w
    
'sort the dates

arrDts.Sort
    dtStart = DateSerial(Year(arrDts(0)), Month(arrDts(0)) - 1, 1)
arrDts.Reverse
    dtEnd = DateSerial(Year(arrDts(0)), Month(arrDts(0)) + 1, 1)
    
arrDts.Add dtStart
arrDts.Add dtEnd
arrDts.Sort

'add intervening months
dt = dtStart
Do Until dt = dtEnd
    dt = DateAdd("m", 1, dt)
    If Not arrDts.contains(dt) Then arrDts.Add dt
Loop

arrDts.Sort
v = arrDts.toarray

Dim vRes
ReDim vRes(1 To UBound(v) + 1, 1 To 1)

'add in the month breaks

For I = 0 To UBound(v)
    If Day(v(I)) <> 1 Then
        vRes(I + 1, 1) = "**" & Format(v(I), "dd-mmm-yyyy") & "** Month break here"
    Else
        vRes(I + 1, 1) = v(I)
    End If
Next I

With Range("c1").Resize(UBound(vRes))
    .EntireColumn.Clear
    .Value = vRes
    .NumberFormat = "dd-mmm-yyyy"
    .EntireColumn.AutoFit
End With

End Sub

请注意，如果您不想让文本与“月份休息”一起出现，则无需将它们设置为文本格式。只需：

For I = 0 To UBound(v)
    vRes(I + 1, 1) = v(I)
Next I

Answer 2

或者另一种方式是这样的：

Sub test()
Set sh1 = Sheets("Sheet7")

With sh1
Set Rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))

Min_date = Application.Min(Rng)
Max_date = Application.Max(Rng)
Max_date = Format(DateAdd("m", 2, Max_date), "mmm-yy")

    Do
    x = Format(DateAdd("m", -1, Max_date), "mmm yy")
    y = Format(DateAdd("m", -2, Min_date), "mmm yy")
    If x = y Then Exit Do
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
    "1" & Format(DateAdd("m", -1, Max_date), "/mmm/yy")
    Max_date = Format(DateAdd("m", -1, Max_date), "mmm yy")
    Loop

Set Rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
Rng.NumberFormat = "d\/mm\/yyyy" '--> the format depends on the computer setting..., mine need to be like that, but other computer maybe can just have d/mm/yyyy
Rng.Sort Key1:=Rng.Columns(1), Order1:=xlAscending, Header:=xlNo
Set strt = .Range("A1")

    Do
    If strt.Value = strt.Offset(1, 0).Value Then strt.Offset(1, 0).Delete Shift:=xlUp
    Set strt = strt.Offset(1, 0)
    Loop Until strt.Value = ""

End With

End Sub

Answer 3

感谢@Ron Rosenfeld 的快速回复..他的解决方案很有魅力..

我做了一些调整以使其按照我的要求工作..

最终代码

    Sub Dts_New()
    Dim arrDts As Object
    Dim v, w, dt, I As Long
    Dim dtStart As Date, dtEnd As Date
    
Set arrDts = CreateObject("System.Collections.ArrayList")

'get unique list of dts
With Worksheets("sheet1")
    v = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
    For Each w In v
        If Not arrDts.contains(w) Then arrDts.Add w
    Next w
    
'sort the dates

arrDts.Sort
    dtStart = DateSerial(Year(arrDts(0)), Month(arrDts(0)) - 1, 1)
arrDts.Reverse
    dtEnd = DateSerial(Year(arrDts(0)), Month(arrDts(0)) + 1, 1)
    
arrDts.Add dtStart
arrDts.Add dtEnd
arrDts.Sort

'add intervening months
dt = dtStart
Do Until dt = dtEnd
    dt = DateAdd("m", 1, dt)
    If Not arrDts.contains(dt) Then arrDts.Add dt
Loop

arrDts.Sort
v = arrDts.toarray

Dim vRes

ReDim vRes(0 To UBound(v) + 1, 1 To 1)

'add in the month breaks

For I = 0 To UBound(v)
    If Day(v(I)) <> 1 Then
        vRes(I, 1) = Format(v(I), "dd-mmm-yyyy")
        'Debug.Print v(I)
    Else
        vRes(I, 1) = v(I)
    'Debug.Print v(I)
    End If
    
    'Debug.Print v(I)
Next I



With Range("c1").Resize(UBound(v) + 1)
    .EntireColumn.Clear
    .Value = vRes
    .NumberFormat = "dd-mmm-yyyy"
    .EntireColumn.AutoFit
End With

End Sub

]

感谢您的帮助..

爱这个社区..希望我能早点知道这个...:)

在 excel vba 中的两个日期之间循环

Looping between two Dates in excel vba

excel

vba

loops

date

between