根据任务时间和当天的可用时间使用VBA进行调度

Question

我正在尝试根据他们花费的时间和不同日期的可用时间来安排任务。以下是部分工作的代码：

Sub Scheduling()

Dim Times As Worksheet
Dim tLR, r, c As Long

Set Times = Worksheets("Times")
tLR = Times.Range("C" & Times.Rows.Count).End(xlUp).row + 1
c = 10
    For r = 18 To tLR
        If Cells(r, 8).Value > Cells(17, c) Then
            If Cells(8, c) > Cells(r, 7) Then
            Cells(r, 9).Value = Cells(17, c).Value
            Cells(r, c).Value = Cells(r, 7).Value
            End If
           End If
        c = c + 1
    Next

End Sub

没有正确检查可用时间，只是将其输入到没有输入时间的下一列。我还会给你一个正在发生的事情的屏幕截图。 如果您有任何疑问，请随时问我。

提前感谢您抽出时间帮助我。

Answer 1

我认为这至少是解决问题的开始：

Sub Scheduling()

    Dim Times As Worksheet
    Dim tLR As Long, r As Long, c As Long

    Set Times = Worksheets("Times")
    tLR = Times.Range("C" & Times.Rows.Count).End(xlUp).row
    For r = 18 To tLR
        c = 10
        Do While Cells(17, c).Value <> ""
            If Cells(r, 8).Value > Cells(17, c).Value Then
                If Cells(8, c).Value > Cells(r, 7).Value Then
                    Cells(r, 9).Value = Cells(17, c).Value
                    Cells(r, c).Value = Cells(r, 7).Value
                    Exit Do
                End If
            End If
            c = c + 1
        Loop
    Next

End Sub

编辑 - 允许多天任务：

Sub Scheduling()

    Dim Times As Worksheet
    Dim tLR As Long, r As Long, c As Long
    Dim timeReq As Double

    Set Times = Worksheets("Times")
    tLR = Times.Range("C" & Times.Rows.Count).End(xlUp).row
    For r = 18 To tLR
        c = 10
        Cells(r, 9).Value = ""
        timeReq = Cells(r, 7).Value
        Do While Cells(17, c).Value <> ""
            If Cells(r, 8).Value > Cells(17, c).Value Then
                If Cells(8, c).Value > 0 Then
                    If Cells(r, 9).Value = "" Then
                        Cells(r, 9).Value = Cells(17, c).Value
                    End If
                    If Cells(8, c).Value >= timeReq Then
                        Cells(r, c).Value = timeReq
                        Exit Do
                    Else
                        timeReq = timeReq - Cells(8, c).Value
                        Cells(r, c).Value = Cells(8, c).Value
                    End If
                End If
            End If
            c = c + 1
        Loop
    Next

End Sub

我还没有测试过这段代码，但我认为这是正确的。

进一步修改以允许每个电台的最大值

这取决于单元格J9：AF15中的公式，它将计算每个站点的可用时间。出于测试目的，我使用了J9中=7-SUMIF($F$18:$F$50,$I9,J$18:J$50)的公式，然后将其复制到整个范围。

Sub Scheduling()

    Dim Times As Worksheet
    Dim tLR As Long, r As Long, c As Long, s As Long
    Dim timeReq As Double
    Dim rng As Range

    Set Times = Worksheets("Times")
    tLR = Times.Range("C" & Times.Rows.Count).End(xlUp).Row
    For r = 18 To tLR
        'Set row number that contains remaining time for this day for this station
        Set rng = Range("I9:I15").Find(What:=Cells(r, "F").Value)
        If rng Is Nothing Then
            'Invalid station entered
            MsgBox "Row " & r & ": Unrecognised station"
        Else
            s = rng.Row
            'Initialise which column to start processing at
            c = 10
            'Reset start date
            Cells(r, 9).Value = ""
            'Set a temporary variable to keep track of how much more
            ' time we need to allocate
            timeReq = Cells(r, "G").Value
            'Loop through each day
            Do While Cells(17, c).Value <> ""
                If Cells(r, "H").Value > Cells(17, c).Value Then
                    If Cells(s, c).Value > 0 Then
                        'Set start date if not already set
                        If Cells(r, "I").Value = "" Then
                            Cells(r, "I").Value = Cells(17, c).Value
                        End If
                        'Check how much time can be used
                        If Cells(s, c).Value >= timeReq Then
                            'We have plenty of time, so assign all to this day
                            Cells(r, c).Value = timeReq
                            'No more to process, so go to the next row
                            Exit Do
                        Else
                            'Can't fit everything into this day, so work out how much
                            'we need to carry forward to another day
                            timeReq = timeReq - Cells(s, c).Value
                            'Allocate all remaining time for this day to this task
                            Cells(r, c).Value = Cells(s, c).Value
                        End If
                    End If
                Else
                    'See if we have hit the due date without yet allocating all the time
                    MsgBox "Row " & r & ": Cannot be scheduled by the due date"
                End If
                'move to the next day
                c = c + 1
            Loop
        End If
    Next

End Sub