我想写一个例程,它允许我在一个跨越设定时间范围的表格中记录日期事件(记录),并且在特定日期没有发生事件的情况下,将创建一个事件复制发生事件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
不幸的是,我的编程知识水平虽然不错,但在这种情况下我不能在逻辑上得出解决方案。我的直觉告诉我,循环可能是正确的解决方案,但我仍然不确定如何。我需要一些指导才能让我开始。
答案 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