Writing a routine to create sequential records

问题:

I would like to write a routine which will allow me to take dated events (records) in a table which span accross a set time frame and in the cases where no event took place for a specific day, an event will be created duplicating the most recent prior record where an event DID take place.

For example: If on September 4 Field 1 = X, Field 2 = Y and Field 3 = Z and then nothing took place until September 8 where Field 1 = Y, Field 2 = Z and Field 3 = X, the routine would create records in the table to account for the 3 days where nothing took place and ultimately return a table looking like:

Sept 4: X - Y - Z Sept 5: X - Y - Z Sept 6: X - Y - Z Sept 7: X - Y - Z Sept 8: Y - Z - X

Unfortunately, my level of programming knowledge although good, does not allow me to logically conclude a solution in this case. My gut feeling tells me that a loop could be the correct solution here but I still an not sure exactly how. I just need a bit of guidance to get me started.

回答1:

Here you go.

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

回答2:

With no details about your specifics (table schema, available language options etc), iI guess that you just need the algorithm to pick up. So here's a quick algorithm with no safeguards.

properdata = "select * from data where eventHasTakenPlace=true";
wrongdata = "select * from data where eventHasTakenPlace=false";
for each wrongRecord in wrongdata {
    exampleRecord = select a.value1, a.value2,...,a.date from properdata as a 
    inner join
    (select id,max(date)
     from properdata
     group by id
     having date<wrongRecord.date
     ) as b
     on a.id=b.id

    minDate = exampleRecord.date;
    maxDate = wrongRecord.date -1day; --use proper date difference function as per your language of choice.
    for i=minDate to maxDate step 1day{
         dynamicsql="INSERT INTO TABLE X(Value1,Value2....,date) VALUES (exampleRecord.Value1, exampleRecord.Value2,...i);
         exec dynamicsql;
    }

}

回答3:

Private Sub Command109_Click()

    On Error GoTo errhandler

    Dim rsEvents As Recordset
    Dim EventDate As Date
    Dim ProjID As String
    Dim Fld1 As String
    Dim Fld2 As String
    Dim Fld3 As String
    Dim Fld4 As String
    Dim Fld5 As String
    Dim Fld6 As String
    Dim Fld7 As String
    Dim Fld8 As String
    Dim Fld9 As String
    Dim Fld10 As String
    Dim Fld11 As String
    Dim Fld12 As String
    Dim Fld13 As String
    Dim Fld14 As String
    Dim Fld15 As String
    Dim Fld16 As String
    Dim Fld17 As String
    Dim Fld18 As String
    Dim Fld19 As String
    Dim Fld20 As String
    Dim Fld21 As String

    Dim st_sql As String
    Dim Sql As String

    Me.Refresh

    Set rsEvents = CurrentDb.OpenRecordset("SELECT * FROM tblProjectMasterListHistory02 ORDER BY LastUpdateDate")
    'Save the current date and info

    EventDate = rsEvents("LastUpdateDate")
    ProjID = rsEvents("ID Project")
    Fld1 = rsEvents("OverallPrincipleStatus1")
    Fld2 = rsEvents("OverallPrincipleStatus2")
    Fld3 = rsEvents("OverallObjectiveStatus")
    Fld4 = rsEvents("OverallObjectiveStatus2")
    Fld5 = rsEvents("OverallDependencyStatus1")
    Fld6 = rsEvents("OverallDependencyStatus2")
    Fld7 = rsEvents("OverallAssumptionsStatus1")
    Fld8 = rsEvents("OverallAssumptionsStatus2")
    Fld9 = rsEvents("OverallConstraintsStatus1")
    Fld10 = rsEvents("OverallConstraintsStatus2")
    Fld11 = rsEvents("ObjectivesScope")
    Fld12 = rsEvents("ObjectivesResources")
    Fld13 = rsEvents("ObjectivesProjectPlan")
    Fld14 = rsEvents("ObjectivesEffort")
    Fld15 = rsEvents("ObjectivesBenefits")
    Fld16 = rsEvents("ObjectivesResourceMobilisation")
    Fld17 = rsEvents("ObjectivesMetrics")
    Fld18 = rsEvents("OverallRiskStatus1")
    Fld19 = rsEvents("OverallRiskStatus2")
    Fld20 = rsEvents("GovernanceStatus1")
    Fld21 = rsEvents("GovernanceStatus2")

    rsEvents.MoveNext

    Do

     ' Loop through each blank date

        Do While EventDate < rsEvents("LastUpdateDate") - 1 'for all dates up to, but not including the next date
            EventDate = EventDate + 1 'advance date by 1 day
            rsEvents.AddNew
            rsEvents("LastUpdateDate") = EventDate
            rsEvents("ID Project") = ProjID
            rsEvents("OverallPrincipleStatus1") = Fld1
            rsEvents("OverallPrincipleStatus2") = Fld2
            rsEvents("OverallObjectiveStatus") = Fld3
            rsEvents("OverallObjectiveStatus2") = Fld4
            rsEvents("OverallDependencyStatus1") = Fld5
            rsEvents("OverallDependencyStatus2") = Fld6
            rsEvents("OverallAssumptionsStatus1") = Fld7
            rsEvents("OverallAssumptionsStatus2") = Fld8
            rsEvents("OverallConstraintsStatus1") = Fld9
            rsEvents("OverallConstraintsStatus2") = Fld10
            rsEvents("ObjectivesScope") = Fld11
            rsEvents("ObjectivesResources") = Fld12
            rsEvents("ObjectivesProjectPlan") = Fld13
            rsEvents("ObjectivesEffort") = Fld14
            rsEvents("ObjectivesBenefits") = Fld15
            rsEvents("ObjectivesResourceMobilisation") = Fld16
            rsEvents("ObjectivesMetrics") = Fld17
            rsEvents("OverallRiskStatus1") = Fld18
            rsEvents("OverallRiskStatus2") = Fld19
            rsEvents("GovernanceStatus1") = Fld20
            rsEvents("GovernanceStatus2") = Fld21

            rsEvents.Update

        Loop

        ' get new current date and info
        EventDate = rsEvents("LastUpdateDate")
        ProjID = rsEvents("ID Project")
        Fld1 = rsEvents("OverallPrincipleStatus1")
        Fld2 = rsEvents("OverallPrincipleStatus2")
        Fld3 = rsEvents("OverallObjectiveStatus")
        Fld4 = rsEvents("OverallObjectiveStatus2")
        Fld5 = rsEvents("OverallDependencyStatus1")
        Fld6 = rsEvents("OverallDependencyStatus2")
        Fld7 = rsEvents("OverallAssumptionsStatus1")
        Fld8 = rsEvents("OverallAssumptionsStatus2")
        Fld9 = rsEvents("OverallConstraintsStatus1")
        Fld10 = rsEvents("OverallConstraintsStatus2")
        Fld11 = rsEvents("ObjectivesScope")
        Fld12 = rsEvents("ObjectivesResources")
        Fld13 = rsEvents("ObjectivesProjectPlan")
        Fld14 = rsEvents("ObjectivesEffort")
        Fld15 = rsEvents("ObjectivesBenefits")
        Fld16 = rsEvents("ObjectivesResourceMobilisation")
        Fld17 = rsEvents("ObjectivesMetrics")
        Fld18 = rsEvents("OverallRiskStatus1")
        Fld19 = rsEvents("OverallRiskStatus2")
        Fld20 = rsEvents("GovernanceStatus1")
        Fld21 = rsEvents("GovernanceStatus2")

        rsEvents.MoveNext
        'new records are placed on the end of the recordset
        'so if we hit an older date, we know it's a recent insert and quit

    Loop Until rsEvents.EOF Or EventDate > rsEvents("LastUpdateDate")


errhandler:

End Sub