在vba中创建两个日期之间的间隔列表

我想制作一个如下所示的列表，将其插入到两个日期范围之间的表格中：

make_intervals_list ('2016-01-01','2020-12-31');
+----------------+--------------+--------+
| interval_start | interval_end |  rate  |
+----------------+--------------+--------+
| 2016-01-01     | 2016-12-31   |   95   |
| 2017-01-01     | 2017-12-31   |  105   | 
| 2018-01-01     | 2018-12-31   |  115   |
| 2019-01-01     | 2019-12-31   |  125   |
| 2020-01-01     | 2020-12-31   |  135   |
+----------------+--------------+--------+

我想要得到的是：

Dim stDate As Date
Dim nxDate As Date
Dim enDate As Date
Dim rate As Integer

stDate = "01/01/2016"
enDate = "31/12/2020"
rate = Me.initial_rate

Do While stDate < enDate
    nxDate = DateAdd("yyyy", 1, stDate)
    stDate = nxDate
    rate = rate + 10
    Debug.Print stDate, nxDate, rate
Loop

---

任何帮助都将不胜感激。

你很接近。您需要两个额外的临时日期来帮助您完成循环：

Dim stDate As Date
Dim nxstDate As Date
Dim nxenDate As Date
Dim nxyrDate As Date
Dim enDate As Date
Dim rate As Integer

stDate = "01/01/2016"
enDate = "31/12/2020"
rate = Me.initial_rate

nxyrDate = stDate
Do While nxyrDate < enDate
    nxstDate = nxyrDate
    nxyrDate = DateAdd("yyyy", 1, nxstDate)
    nxenDate = DateAdd("d", -1, nxyrDate)
    Debug.Print nxstDate, nxenDate, rate
    rate = rate + 10
Loop

希望有帮助：）

**编辑**

回答将结果放入表格请求的附加代码：

首先，需要在Access数据库中创建表

我打电话给我的桌子：

tblIntervals\u List

但是您可以随意调用您的表名，只需在下面的代码中将

tblIntervals\u List

更改为您的表名即可

在表

tblIntervals\u列表中

需要三个字段。您可以根据需要为字段命名。但前两个字段必须是数据类型

Date/Time

，第三个字段必须是数据类型

Number

例如：

tblIntervals_List 

Field Name           Data Type

Interval_Start       Date/Time 
Interval_End         Date/Time 
Rate                 Number

正确创建表后，可以修改代码

首先，您需要为SQL插入文本添加另一条Dim语句：

Dim strSQLText As String

然后，您需要关闭警告，这样就不必在每次插入记录后按空格键

DoCmd.SetWarnings (WarningsOff)

然后在循环中，您需要创建SQL插入代码：

strSQLText = "INSERT INTO tblIntervals_List VALUES ('" & _
             nxstDate & "', '" & _
             nxenDate & "', " & _
             rate & ") "

并使用

Docmd

语句运行它：

DoCmd.RunSQL strSQLText

然后，循环完成后，您需要重置以下警告：

DoCmd.SetWarnings (WarningsOn)

如果需要，给用户一个消息框，让他们知道查询实际上做了什么：

MsgBox "Records added to tblIntervals_List"

另外，不要忘记注释掉你的

Debug.Print

所有这些步骤都包含在下面的代码中：

Dim stDate As Date
Dim nxstDate As Date
Dim nxenDate As Date
Dim nxyrDate As Date
Dim enDate As Date
Dim rate As Integer

Dim strSQLText As String

DoCmd.SetWarnings (WarningsOff)

stDate = "01/01/2016"
enDate = "31/12/2020"
rate = Me.initial_rate

nxyrDate = stDate
Do While nxyrDate < enDate
    nxstDate = nxyrDate
    nxyrDate = DateAdd("yyyy", 1, nxstDate)
    nxenDate = DateAdd("d", -1, nxyrDate)
'    Debug.Print nxstDate, nxenDate, rate

    strSQLText = "INSERT INTO tblIntervals_List VALUES ('" & _
                 nxstDate & "', '" & _
                 nxenDate & "', " & _
                 rate & ") "
    DoCmd.RunSQL strSQLText

    rate = rate + 10
Loop

DoCmd.SetWarnings (WarningsOn)
MsgBox "Records added to tblIntervals_List"

Dim stDate作为日期
Dim nxstDate作为日期
标注nxenDate作为日期
日期为日期
日期
变暗速率为整数
将strSQLText设置为字符串
DoCmd.SetWarnings（警告关闭）
stDate=“01/01/2016”
enDate=“31/12/2020”
速率=Me.初始速率
nxyrDate=stDate
当nxyrDate

该代码将向Access表中添加带有日期和费率的记录

---

希望对您有所帮助：）

这就是我要做的，以便于您打印：

Dim stDate As Date
Dim nxDate As Date
Dim enDate As Date
Dim rate As Integer
Dim array_var As Variant

' additional variables
Dim coll_temp As Collection
Set coll_temp = New Collection
Dim array_temp(2) As Variant

' initialize initial variables
stDate = "01/01/2016"
nxDate = DateAdd("yyyy", 1, stDate)
nxDate = DateAdd("d", -1, nxDate)
enDate = "31/12/2020"
rate = 95 ' for you this would be Me.initial_rate

Do While stDate < enDate
    ' load array
    array_temp(0) = stDate
    array_temp(1) = nxDate
    array_temp(2) = rate

    ' add to collection
    coll_temp.Add Item:=array_temp

    ' increment dates
    nxDate = DateAdd("yyyy", 1, nxDate)
    stDate = DateAdd("yyyy", 1, stDate)
    rate = rate + 10
Loop

---

我希望这会有帮助。

是的，很完美。非常感谢您。您能帮我将此记录集插入table@MirAbzal Ali：我编辑了上面的答案，向您展示了如何启动将记录插入表的SQL代码。：）

Dim stDate As Date
Dim nxstDate As Date
Dim nxenDate As Date
Dim nxyrDate As Date
Dim enDate As Date
Dim rate As Integer

Dim strSQLText As String

DoCmd.SetWarnings (WarningsOff)

stDate = "01/01/2016"
enDate = "31/12/2020"
rate = Me.initial_rate

nxyrDate = stDate
Do While nxyrDate < enDate
    nxstDate = nxyrDate
    nxyrDate = DateAdd("yyyy", 1, nxstDate)
    nxenDate = DateAdd("d", -1, nxyrDate)
'    Debug.Print nxstDate, nxenDate, rate

    strSQLText = "INSERT INTO tblIntervals_List VALUES ('" & _
                 nxstDate & "', '" & _
                 nxenDate & "', " & _
                 rate & ") "
    DoCmd.RunSQL strSQLText

    rate = rate + 10
Loop

DoCmd.SetWarnings (WarningsOn)
MsgBox "Records added to tblIntervals_List"

Dim stDate As Date
Dim nxDate As Date
Dim enDate As Date
Dim rate As Integer
Dim array_var As Variant

' additional variables
Dim coll_temp As Collection
Set coll_temp = New Collection
Dim array_temp(2) As Variant

' initialize initial variables
stDate = "01/01/2016"
nxDate = DateAdd("yyyy", 1, stDate)
nxDate = DateAdd("d", -1, nxDate)
enDate = "31/12/2020"
rate = 95 ' for you this would be Me.initial_rate

Do While stDate < enDate
    ' load array
    array_temp(0) = stDate
    array_temp(1) = nxDate
    array_temp(2) = rate

    ' add to collection
    coll_temp.Add Item:=array_temp

    ' increment dates
    nxDate = DateAdd("yyyy", 1, nxDate)
    stDate = DateAdd("yyyy", 1, stDate)
    rate = rate + 10
Loop

' print out each element in collection
For Each array_var In coll_temp
    ' print out each element in array
    For int_element = 0 To UBound(array_temp)
        ' print the element
        Debug.Print array_var(0); array_var(1); array_var(2)
    Next int_element
Next