编写例程来创建顺序记录

时间:2014-08-09 17:00:58

标签: sql access-vba ms-access-2010

我想写一个例程,它允许我在一个跨越设定时间范围的表格中记录日期事件(记录),并且在特定日期没有发生事件的情况下,将创建一个事件复制发生事件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

不幸的是,我的编程知识水平虽然不错,但在这种情况下我不能在逻辑上得出解决方案。我的直觉告诉我,循环可能是正确的解决方案,但我仍然不确定如何。我需要一些指导才能让我开始。

3 个答案:

答案 0 :(得分:2)

你走了。

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

答案 1 :(得分:1)

没有关于您的细节的详细信息(表格架构,可用的语言选项等),我猜你只需要算法来获取。所以这是一个没有安全措施的快速算法。

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;
    }

}

答案 2 :(得分:0)

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