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

时间:2017-08-25 18:35:53

标签: vba ms-access

我希望列表如下所示插入两个日期范围之间的表格:

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

输出:

01/01/2018    01/01/2018     115 
01/01/2019    01/01/2019     125 
01/01/2020    01/01/2020     135 
01/01/2021    01/01/2021     145 

任何帮助都将不胜感激。

2 个答案:

答案 0 :(得分:1)

你很亲密。您需要两个额外的临时日期来帮助您完成循环:

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

输出:

1/1/2016      12/31/2016     95 
1/1/2017      12/31/2017     105 
1/1/2018      12/31/2018     115 
1/1/2019      12/31/2019     125 
1/1/2020      12/31/2020     135

希望有所帮助:)

** 编辑 **

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

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

我打电话给我的桌子:tblIntervals_List

但是你可以随意打电话给你,只需在下面的代码中将tblIntervals_List更改为你的表名。

在表tblIntervals_List中,您需要三个字段。您可以根据需要为字段命名。但前两个字段必须是数据类型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"

该代码将使用您的日期和费率向您的Access表添加记录。

希望有所帮助:)

答案 1 :(得分:0)

我会这样做,以便您打印出来:

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

我希望这会有所帮助。