タスク時間とその日の利用可能時間に基づいて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 

私はそのコードをテストしていないが、それは正しいと思う。 AF15駅ごとに使用可能な時間を計算します：これは、細胞のJ9で式に依存している駅あたり最大

を可能にする

---

さらに編集。テスト目的のために私は=7-SUMIF($F$18:$F$50,$I9,J$18:J$50)のJ9に式を入れて、それを全体の範囲にコピーしました。

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