Question

我不是VBA专家。我只是从网上复制并尝试在我的程序中使用。但是，下面是我的代码。我正在考虑考虑休假时间来计算完成日期，但是问题是有时所需的时间少于一天，在这种情况下，它计算为1天。如何按小时计算。假设开始日期是2019年1月1日上午6:00，并且所需的制作时间比结束时间多6个小时，则应该是2019年1月1日下午12:00

Public Function AddFinishDate(StartDate As Date, ReqDays As Double, FriOff As Boolean) As Date

    Dim rst As Recordset
    Dim db As Database
    Dim FinishDate As Date
    Dim icount As Integer


    On Error GoTo errhandlers:
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tblHoliday", dbOpenSnapshot)
    icount = 0
    FinishDate = StartDate
    Do While icount < ReqDays
        FinishDate = FinishDate + 1
        If Weekday(FinishDate, vbSaturday) <> 7 Or FriOff = False Then
            rst.FindFirst "(HolidayDate)= #" & FinishDate & "#"
            If rst.NoMatch Then
                icount = icount + 1
            End If
        End If

    Loop
        AddFinishDate = FinishDate

    exit_errhandlers:
        rst.Close
        Set rst = Nothing
        Set db = Nothing
        AddFinishDate = FinishDate
        Exit Function

    errhandlers:
        MsgBox Err.Description, vbExclamation
        Resume Next

    End Function

    Private Sub Command53_Click()
    Dim dbs As DAO.Database
        Set dbs = CurrentDb()
        dbs.Execute "UPDATE BalFitToFabricate " & "SET used = false , startdate ="""",finishdate ="""";"
        Me.Refresh
    End Sub

    Private Sub Command71_Click()
    Dim dbs As DAO.Database, Initrst, rst, rst2 As DAO.Recordset
    Dim strSQL
    Dim ClientsTableQuery, SalesRepList As TableDef
    Dim DataB As Database
    Dim ClientQD As QueryDef
    Dim rstClient As DAO.Recordset
    Dim DurationTotal, Counter, i As Integer
    Dim LowDate1, LowDate2 As Date
    Dim tmpArray(10), FieldArray(10), TempDate1, TempDate2 As Date
    Dim TotalDailyHrs, TempDailyHours As Integer
    Dim FirstTimeIn As Boolean


    FirstTimeIn = False

    TotalDailyHrs = Forms("BalFitToFabricate").Text49.Value
    TempDailyHours = TotalDailyHrs

    Set dbs = CurrentDb()
    ClientsTableQuery = "BalFitToFabricate"

    'strSQL = "Select * from Client_Table"
    Set DataB = CurrentDb()

    Set rstClient = DataB.OpenRecordset(ClientsTableQuery)
    rstClient.MoveFirst
    Counter = 0

    Set Initrst = dbs.OpenRecordset("SELECT * FROM  BalFitToFabricate;")


    'Set rst = dbs.OpenRecordset("SELECT * FROM BalFitToFabricate;")
    Set rst = dbs.OpenRecordset("SELECT * FROM (SELECT * FROM (SELECT * FROM BalFitToFabricate WHERE Used = false)) WHERE FinishDate = (select min(FinishDate) from BalFitToFabricate where Used = false);")
    Set rst2 = dbs.OpenRecordset("SELECT * FROM BalFitToFabricate WHERE isnull(StartDate) order by NULLSORTER,Req_Del_Date,Priority;")

    'Autonumrst.Requery

    'MsgBox Initrst.RecordCount & " " & rst.RecordCount & " " & rst2.RecordCount

    'First Loop
    Do Until rstClient.EOF = True
        If TempDailyHours <= TotalDailyHrs Then
            'Autonumrst.Requery

            'If FirstTimeIn = False Then
            '    TotalDailyHrs = TotalDailyHrs - TempDailyHours
            'End If

            TempDailyHours = Initrst![CreqHours]


            Dim Autonumrst, Valuesrst As DAO.Recordset
            Dim strSQL2, strSQL3 As String

            'strSQL2 = "SELECT [Crew Hours] FROM Table2 where AutoNum = " & Initrst!Autonum & "and used = false;"
            strSQL2 = "SELECT [CreqHours] FROM Table2 where Used = False;"
            strSQL3 = "SELECT * FROM Table2 where Used = False;"

            Set Autonumrst = CurrentDb.OpenRecordset(strSQL2)
            Set Valuesrst = CurrentDb.OpenRecordset(strSQL3)
            ' new code:

            'Stopped 2 lines
            'TempDailyHours = Autonumrst![Crew Hours]
            'Autonumrst.Requery

            'Autonumrst.Close


            'TempDailyHours = dbs.Execute "select BalFitToFabricate " & "SET startdate = #" & TempDate1 & "# WHERE Autonum = " & Initrst!Autonum & ";"


            TotalDailyHrs = TotalDailyHrs - TempDailyHours

            If TotalDailyHrs > 0 Then

                TempDate1 = Format([Forms]![BalFitToFabricate]![Text51].Value, "mm-dd-yyyy")
                'TempDate1 = [Forms]![BalFitToFabricate]![Text68].Value
                dbs.Execute "UPDATE BalFitToFabricate " & "SET startdate = #" & TempDate1 & "# WHERE ID = " & Initrst!ID & ";"


                TempDate2 = AddFinishDate(Format(TempDate1, "mm-dd-yyyy"), Initrst!ReqDays, Me.FridayOffCheckBox2)
                dbs.Execute "UPDATE BalFitToFabricate " & "SET finishdate = #" & TempDate2 & "# WHERE ID = " & Initrst!ID & ";"


                'TempDate1 = strSQL59 + (strSQL22 / strSQL57)

                'TempDate2 = Format(TempDate1 + (Valuesrst![Total_Req_Manhours] / Valuesrst![Crew Hours]), "dd-mm-yyyy")
                'dbs.Execute "UPDATE BalFitToFabricate " & "SET Finishdate = #" & TempDate2 & "# WHERE Autonum = " & Initrst!AutoNum & ";"

                dbs.Execute "UPDATE BalFitToFabricate " & "SET Used = True WHERE ID = " & Initrst!ID & ";"
            End If

            Initrst.MoveNext
            'Autonumrst.MoveNext
        Else
            GoTo ExitLoop1
        End If

    Loop

    ExitLoop1:
    'MsgBox rst!Ord_No & " " & rst2!Ord_No
    dbs.Execute "UPDATE BalFitToFabricate " & "SET Used = False;"
    TotalDailyHrs = Forms("BalFitToFabricate").Text49.Value
    TempDailyHours = TotalDailyHrs

    'Second Loop
    Do Until rstClient.EOF = True

        'Counter = Counter + 1
        'i = rstClient!Ord_No
        'If rstClient.Fields("Duration") <> "" Then
        '    DurationTotal = DurationTotal + rstClient.Fields("Duration")
            'FieldArray(Counter) = rstClient.Fields("End")

        'End If

        'If DurationTotal >= 15 Then
        If TempDailyHours <= TotalDailyHrs Then
            'If rstClient!Used = False Then
                strSQL3 = "SELECT * FROM Table2 where Finishdate is null;"
                Set Valuesrst = CurrentDb.OpenRecordset(strSQL3)
                Valuesrst.Requery

                'Counter = rst2.RecordCount
                Dim temp22 As Integer

                temp22 = rst.RecordCount
                rst.Requery
                rst2.Requery
                If rst2.RecordCount <= 0 Then
                    GoTo ExitLoop2
                End If
                LowDate1 = "#" & rst!FinishDate & "#"
                'LowDate2 = "#" & Valuesrst!finishdate & "#"
            'End If
            ''Set dbs = OpenDatabase("database41.accdb")
            TempDate1 = Format(rst!FinishDate, "mm-dd-yyyy")

            dbs.Execute "UPDATE BalFitToFabricate " & "SET Used = true WHERE ID = " & rst!ID & ";"
            dbs.Execute "UPDATE BalFitToFabricate " & "SET startdate = #" & TempDate1 & "# WHERE ID = " & rst2!ID & ";"

            'TempDate1 = Format([Forms]![BalFitToFabricate]![Text59].Value + ([Forms]![BalFitToFabricate]![Text22].Value / [Forms]![BalFitToFabricate]![Text57].Value), "dd-mm-yyyy")
            'TempDate1 = Format(Valuesrst![StartDate] + (Valuesrst![Total_Req_Manhours] / Valuesrst![Crew Hours]), "dd-mm-yyyy")
            'dbs.Execute "UPDATE BalFitToFabricate " & "SET Finishdate = #" & TempDate1 & "# WHERE Autonum = " & Valuesrst!AutoNum & ";"

            TempDate2 = AddFinishDate(Format(TempDate1, "mm-dd-yyyy"), rst!ReqDays, Me.FridayOffCheckBox2)
            dbs.Execute "UPDATE BalFitToFabricate " & "SET finishdate = #" & TempDate2 & "# WHERE ID = " & rst2!ID & ";"

        End If
        'rstClient.MoveNext

    Loop

    ExitLoop2:
    MsgBox "Finished Scheduling " & DurationTotal & "Time: " & Time()
    rstClient.Close

    [Forms]![BalFitToFabricate].Refresh

    End Sub

Answer 1

如果您不全天候工作，这并不是那么容易。我有一个旧功能，需要考虑下班时间和周末，但不考虑假期：

Public Function WorkhourAdd( _
  ByVal datDateStart As Date, _
  ByVal intHours As Integer) _
  As Date

' Purpose: Add number of working hours to date datDateStart.
' Assumes: 5 working days per week. Adjust cbytWorkdaysOfWeek for other values.
'          First workday is Monday.
'          Weekend is up to and including Sunday.
' Limitation: Does not count for public holidays.
' May be freely used and distributed.
'
' 2011-01-15. Gustav Brock, Cactus Data ApS, Copenhagen

  ' Specify begin and end time of daily working hours.
  Const cdatWorkTimeStart   As Date = #8:00:00 AM#
  Const cdatWorkTimeStop    As Date = #4:00:00 PM#
  Const cbytWorkdaysOfWeek  As Byte = 5

  Dim intCount    As Integer
  Dim datDateEnd  As Date

  datDateEnd = datDateStart
  While intCount < intHours
    datDateEnd = DateAdd("h", 1, datDateEnd)
    If Weekday(datDateEnd, vbMonday) <= cbytWorkdaysOfWeek Then
      If DateDiff("h", cdatWorkTimeStart, TimeValue(datDateEnd)) > 0 Then
        If DateDiff("h", TimeValue(datDateEnd), cdatWorkTimeStop) >= 0 Then
          intCount = intCount + 1
        End If
      End If
    End If
  Wend

  WorkhourAdd = datDateEnd

End Function

您可以对其进行修改，以检查时间是否在假期内，以查找假期的结束时间。

考虑休息日和假期计算完成日期和时间

1 个答案: