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

我正在尝试根据所花时间和不同日子的时间安排任务。 这是部分工作的代码：

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 

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

预先感谢您的时间帮助我。

Answer 1

我认为这至less是解决你的问题的一个开始 ：

 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 

我没有testing过这个代码，但我认为这是对的。

---

进一步编辑以允许每个站点的最大值

这取决于单元格J9：AF15中的公式，它将计算每个站点的可用时间。 为了testing目的，我使用了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