Sub 填排程()
Dim CelStr As Range, Ri%, Arr, C%, WkD%, DayAdd%
Set CelStr = Rows(5).Find([H8], , xlValues, xlWhole)
[L6].Resize(4, 2000).ClearContents
CelStr(2) = "開始": CelStr(2).Select '開始日期
With Sheets("產品清單")
Ri = .[B:B].Find([H6], , xlValues, xlWhole).Row
Arr = Range(.Cells(Ri - 1, "E"), .Cells(Ri + 1, "D").End(2))
End With
For C = 1 To UBound(Arr, 2)
WkD = Arr(3, C): DayAdd = 0
Do Until WkD = 0
DayAdd = DayAdd + 1
If CelStr(0, 1 + DayAdd) <> "S" Then WkD = WkD - 1
Loop
CelStr(2, 1 + DayAdd) = Arr(1, C)
CelStr(3, 1 + DayAdd) = Arr(2, C)
If C <> UBound(Arr, 2) Then
CelStr(4, 1 + DayAdd) = Arr(1, C + 1)
CelStr(5, 1 + DayAdd) = Arr(2, C + 1)
Set CelStr = CelStr(, 1 + DayAdd)
End If
Next C
End Sub
