小编典典

编写例程以创建顺序记录

sql

我想编写一个例程,该例程将允许我在跨越设定时间范围的表中记录日期已久的事件(记录),并且在特定的一天没有发生任何事件的情况下,将创建一个重复次数最多的事件事件DID发生的最近的先前记录。

例如:如果在9月4日,字段1 = X,字段2 = Y,字段3 = Z,然后什么也没有发生,直到9月8日字段1 = Y,字段2 = Z,字段3 =
X,该例程将创建记录在表格中说明3天什么都没发生的情况,最终返回如下表格:

9月4日:X-Y-Z 9月5日:X-Y-Z 9月6日:X-Y-Z 9月7日:X-Y-Z 9月8日:Y-Z-X

不幸的是,尽管我的编程知识水平很高,但在这种情况下我无法从逻辑上得出解决方案。我的直觉告诉我,循环可能是此处的正确解决方案,但我仍不确定确切的方法。我只需要一点指导就可以开始。


阅读 192

收藏
2021-04-07

共1个答案

小编典典

干得好。

Sub FillBlanks()
    Dim rsEvents As Recordset
    Dim EventDate As Date
    Dim Fld1 As String
    Dim Fld2 As String
    Dim Fld3 As String
    Dim SQL As String

    Set rsEvents = CurrentDb.OpenRecordset("SELECT * FROM tblevents ORDER BY EventDate")
    'Save the current date & info
    EventDate = rsEvents("EventDate")
    Fld1 = rsEvents("Field1")
    Fld2 = rsEvents("Field2")
    Fld3 = rsEvents("Field3")
    rsEvents.MoveNext
    On Error Resume Next
    Do
        ' Loop through each blank date
        Do While EventDate < rsEvents("EventDate") - 1 'for all dates up to, but not including the next date
            EventDate = EventDate + 1 'advance date by 1 day
            rsEvents.AddNew
            rsEvents("EventDate") = EventDate
            rsEvents("Field1") = Fld1
            rsEvents("Field2") = Fld2
            rsEvents("Field3") = Fld3
            rsEvents.Update
        Loop
        ' get new current date & info
        EventDate = rsEvents("EventDate")
        Fld1 = rsEvents("Field1")
        Fld2 = rsEvents("Field2")
        Fld3 = rsEvents("Field3")
        rsEvents.MoveNext
        ' new records are placed on the end of the recordset,
        ' so if we hit on older date, we know it's a recent insert and quit
    Loop Until rsEvents.EOF Or EventDate > rsEvents("EventDate")
End Sub
2021-04-07