Как я могу вставить строки на основе данных предыдущей и следующей записи в данные MS Access, упорядоченные по времени?

Question

В MS Access Моя таблица выглядит следующим образом:

ProductName , Date , Time , Price
Apple , 05-April-2020, 9:15:59 , 110
Apple , 05-April-2020, 9:16:59 , 112
Apple , 05-April-2020, 9:17:59 , 108
Apple , 05-April-2020, 9:18:59 , 125
Apple , 05-April-2020, 9:20:59 , 110

Apple , 06-April-2020, 10:20:59 , 85
Apple , 06-April-2020, 10:21:59 , 82
Apple , 06-April-2020, 10:22:59 , 86
Apple , 06-April-2020, 10:25:59 , 84

Orange , 05-April-2020, 2:15:59 PM , 110
Orange , 05-April-2020, 2:16:59 PM , 112
Orange , 05-April-2020, 2:17:59 PM , 108
Orange , 05-April-2020, 2:18:59 PM , 125
Orange , 05-April-2020, 2:20:59 PM , 110

Orange , 10-April-2020, 2:21:59 , 85
Orange , 10-April-2020, 2:22:59 , 82
Orange , 10-April-2020, 2:26:59 , 86
Orange , 10-April-2020, 2:27:59 , 84

Данные с 9:15:59 до 15:29:59 для каждой даты (всегда 59-й секунды) для каждого продукта (тысяч) за 4 года данных. Мне нужно заполнить пробелы для каждого продукта на каждую дату, например,

9:19 AM for apple on 05 April-2020
10:23 AM for apple on 05 April-2020
10:24 AM for apple on 05 April-2020

и так далее. Вставляйте новые записи там, где это необходимо, копируя предыдущую цену записи, соответствующие имена продуктов, дату и новое время. Если это может быть (цена 9:15 + 9:17) / 2, то для 9:16 даже лучше. Только там, где его не хватает. Каждый день для определенного c продукта, если он существует в этот день, должен иметь 375 строк, соответствующих 375 минутам с 9:15 до 3:30. В идеале на изделие должно быть не более 5-10 вкладышей в день. Если мы можем сгенерировать отчет, мы можем отследить, сколько вставок было сделано для отслеживания любых ложных записей.

Большое спасибо, с нетерпением жду :))

Answer 1

Я собрал некоторый код, который генерирует недостающие записи, включая перенос последнего значения за предыдущий день, если это необходимо.

Однако я не даю абсолютно никаких гарантий относительно скорости !!

Sub sMissingPrice()
    On Error GoTo E_Handle
    Dim db As DAO.Database
    Dim rsDay As DAO.Recordset
    Dim rsLookup As DAO.Recordset
    Dim dtmTemp As Date
    Dim strSQL As String
    Const JetDateFmt = "\#mm\/dd\/yyyy\#;;;\N\u\l\l"
    Const JetTimeFmt = "\#hh\:nn\:ss\#;;;\N\u\l\l"
    Set db = DBEngine(0)(0)
    Set rsDay = db.OpenRecordset("SELECT DISTINCT ProductName, ProductDate FROM tblProductPrice ORDER BY ProductName, ProductDate;")
    If Not (rsDay.BOF And rsDay.EOF) Then
        Do
            dtmTemp = #9:15:59 AM#
'   make sure that there is a value for 09:15:59. otherwise get the last price from the previous day
            strSQL = "SELECT ProductTime, Price FROM tblProductPrice " _
                & " WHERE ProductName='" & rsDay!ProductName & "' AND ProductDate=" & Format(rsDay!ProductDate, JetDateFmt) & " AND ProductTime=" & Format(dtmTemp, JetTimeFmt)
            Set rsLookup = db.OpenRecordset(strSQL)
            If (rsLookup.BOF And rsLookup.EOF) Then
                Set rsLookup = db.OpenRecordset("SELECT Price FROM tblProductPrice " _
                    & " WHERE ProductName='" & rsDay!ProductName & "' AND ProductDate=" & Format(rsDay!ProductDate - 1, JetDateFmt) & " AND ProductTime=" & Format(#3:29:59 PM#, JetTimeFmt))
                If Not (rsLookup.BOF And rsLookup.EOF) Then
                    db.Execute "INSERT INTO tblProductPrice (ProductName,ProductDate,ProductTime,Price) " _
                        & " SELECT '" & rsDay!ProductName & "'," & Format(rsDay!ProductDate, JetDateFmt) & "," & Format(dtmTemp, JetTimeFmt) & "," & rsLookup!Price
                End If
            End If
' now loop through each minute of the day checking to see if we have data
            Do
                strSQL = "SELECT Price FROM tblProductPrice " _
                    & " WHERE ProductName='" & rsDay!ProductName & "' AND ProductDate=" & Format(rsDay!ProductDate, JetDateFmt) & " AND ProductTime=" & Format(dtmTemp, JetTimeFmt)
                Set rsLookup = db.OpenRecordset(strSQL)
                If (rsLookup.BOF And rsLookup.EOF) Then
                    Set rsLookup = db.OpenRecordset("SELECT Price FROM tblProductPrice " _
                        & " WHERE ProductName='" & rsDay!ProductName & "' AND ProductDate=" & Format(rsDay!ProductDate, JetDateFmt) & " AND ProductTime=" & Format(DateAdd("n", -1, dtmTemp), JetTimeFmt))
                    If Not (rsLookup.BOF And rsLookup.EOF) Then
                        db.Execute "INSERT INTO tblProductPrice (ProductName, ProductDate, ProductTime, Price) " _
                            & " SELECT '" & rsDay!ProductName & "'," & Format(rsDay!ProductDate, JetDateFmt) & "," & Format(dtmTemp, JetTimeFmt) & "," & rsLookup!Price
                    End If
                End If
                dtmTemp = DateAdd("n", 1, dtmTemp)
            Loop Until dtmTemp > #3:30:00 PM#
            rsDay.MoveNext
        Loop Until rsDay.EOF
    End If
sExit:
    On Error Resume Next
    rsDay.Close
    rsLookup.Close
    Set rsDay = Nothing
    Set rsLookup = Nothing
    Set db = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sMissingPrice", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

С уважением,