تکمیل ظرفیت روزانه با احتساب مقادیر اولیه

[mazoolagh]

روتین پر کردن جدول OrderByDate :

Sub Calc()

DoCmd.RunSQL "Delete * From OrderByDate"

Dim rsP As Recordset

Dim rsO As Recordset

Dim rsOBD As Recordset

Set rsO = CurrentDb.OpenRecordset("SELECT * FROM Orders ORDER BY OrderID")

Set rsP = CurrentDb.OpenRecordset("SELECT * FROM Production ORDER BY [Date]")

Set rsOBD = CurrentDb.OpenRecordset("OrderByDate")

Dim OQ, PQ, Q As Long

PQ = rsP("Quantity")

OQ = rsO("Quantity")

Do

    Q = IIf(PQ < OQ, PQ, OQ)

    If Q > 0 Then

        rsOBD.AddNew

        rsOBD("OrderID") = rsO("OrderID")

        rsOBD("[Date]") = rsP("[Date]")

        rsOBD("Quantity") = Q

        rsOBD.Update

    End If

    If PQ >= OQ Then

        PQ = PQ - OQ

        rsO.MoveNext

        If rsO.EOF Then Exit Do

        OQ = rsO("Quantity")

    Else

        OQ = OQ - PQ

        rsP.MoveNext

        If rsP.EOF Then Exit Do

        PQ = rsP("Quantity")

    End If

Loop

rsP.Close

rsO.Close

rsOBD.Close

Set rsP = Nothing

Set rsO = Nothing

Set rsOBD = Nothing

End Sub