Hsieh

回復 3# adam2010


    排程應該會考慮每批最大量或最小量是多少?
就以1/1的250來說，為何要排成2批100、200
不能排100、150嗎?
程式設計必須考慮到整體邏輯相通，若有特別規定就必須詳細說明各種限制條件
才能整理出共同特性來解決問題

Hsieh

回復 8# adam2010
Sheets("交期")的D欄數量是人工先輸入好的嗎?
試試看

1. Sub ex()
   
2. Dim Ar(), Ay(), C As Range, Rng As Range
   
3. Set d = CreateObject("Scripting.Dictionary") '數量
   
4. Set d1 = CreateObject("Scripting.Dictionary") '日期
   
5. With Sheets("出貨日")
   
6. For Each a In .Range(.[A2], .[A2].End(xlDown)) '物料
   
7.   Set Rng = a.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers) '訂貨
   
8.   ReDim Preserve Ar(s) '數量
   
9.   ReDim Preserve Ay(s) '日期
   
10.   Ar(s) = 0
    
11.   Ay(s) = .Cells(1, Rng.Column)
    
12.   s = s + 1
    
13.      For Each C In Rng
    
14.         cnt = cnt + C
    
15.         ReDim Preserve Ar(s)
    
16.         ReDim Preserve Ay(s)
    
17.         Ar(s) = cnt
    
18.         Ay(s) = .Cells(1, C.Column).Value
    
19.         s = s + 1
    
20.      Next
    
21.      d(a.Value) = Ar
    
22.      d1(a.Value) = Ay
    
23.      Erase Ar: Erase Ay: s = 0: cnt = 0
    
24. Next
    
25. End With
    
26. With Sheets("交期")
    
27.   For Each a In .Range(.[A2], .[A2].End(xlDown))
    
28.      cnt = cnt + a.Offset(, 3)
    
29.      If cnt <= Application.Max(d(a.Value)) Or cnt - a.Offset(, 3) < Application.Max(d(a.Value)) Then _
    
30.      a.Offset(, 4) = Application.Lookup(cnt, d(a.Value), d1(a.Value)) _
    
31.      Else a.Offset(, 4) = "NA"
    
32.      If a <> a.Offset(1) Then cnt = 0
    
33.   Next
    
34. End With
    
35. End Sub

複製代碼

Hsieh

回復 10# adam2010
Lookup函數並不適用

1. Sub ex()
   
2. Dim Ar(), Ay(), C As Range, rng As Range
   
3. Set d = CreateObject("Scripting.Dictionary") '數量
   
4. Set d1 = CreateObject("Scripting.Dictionary") '日期
   
5. With Sheets("出貨日")
   
6. For Each a In .Range(.[A2], .[A2].End(xlDown)) '物料
   
7.   Set rng = a.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers) '應交貨數量
   
8.      For Each C In rng
   
9.         cnt = cnt + C
   
10.         ReDim Preserve Ar(s)
    
11.         ReDim Preserve Ay(s)
    
12.         Ar(s) = cnt
    
13.         Ay(s) = .Cells(1, C.Column).Value
    
14.         s = s + 1
    
15.      Next
    
16.      d(a.Value) = Ar
    
17.      d1(a.Value) = Ay
    
18.      Erase Ar: Erase Ay: s = 0: cnt = 0
    
19. Next
    
20. End With
    
21. With Sheets("交期")
    
22.   For Each a In .Range(.[A2], .[A2].End(xlDown))
    
23.      cnt = cnt + a.Offset(, 3)
    
24.      If cnt <= Application.Max(d(a.Value)) Or cnt - a.Offset(, 3) < Application.Max(d(a.Value)) Then
    
25.      i = 0
    
26.      Do Until cnt - a.Offset(, 3) < d(a.Value)(i) Or i = UBound(d(a.Value))  '找到陣列中比已交貨數量還大的應交貨數量
    
27.      n = d(a.Value)(i)
    
28.        i = i + 1
    
29.      Loop
    
30.      a.Offset(, 4) = d1(a.Value)(i)
    
31.      Else
    
32.      a.Offset(, 4) = "NA"
    
33.      End If
    
34.      If a <> a.Offset(1) Then cnt = 0
    
35.   Next
    
36. End With
    
37. End Sub

複製代碼