[發問] 求助~排程填入日期

adam2010

由於小弟的巨集功力不足，想請教板上各位高手下面這個問題~
想要將出貨日

下載 (23.88 KB)
出貨日

2013-1-10 01:04

拆開到各子批的交期

下載 (49.54 KB)
交期

2013-1-10 01:04

如說明

下載 (113.32 KB)
說明

2013-1-10 01:04

跪求各位大大協助~謝謝！
排程問題.rar (4.82 KB)

檔案
下載次數: 21

2013-1-10 00:56

dino1978

回復 1# adam2010


    試試看吧

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim LotID As Range, Tagt As Range, Qty As Range
   
4. Dim a, TalQty
   
5. 
   
6. With sheet2
   
7. 
   
8.     For Each LotID In .Range("A2:A" & .[A65536].End(xlUp).Row)
   
9.    
   
10.         For Each Tagt In .Range("B" & LotID.Row & ":J" & LotID.Row)
    
11.         
    
12.             If Tagt <> "" Then
    
13.         
    
14.                 With Sheet1
    
15.             
    
16.                     a = Application.Match(LotID, .[A:A], 0)
    
17.                     aa = Application.CountIf(.[A:A], LotID)
    
18.                     TalQty = 0
    
19.         
    
20.                     For Each Qty In .Range("D" & a & ":D" & (a + aa - 1))
    
21.             
    
22.                         If Qty.Offset(, 1) <> "" Then GoTo ntxa
    
23.                
    
24.                         Qty = Qty + TalQty
    
25.                
    
26.                         If Qty < Tagt Then
    
27.                         
    
28.                             Qty.Offset(, 1) = sheet2.Cells(1, Tagt.Column)
    
29.                             TalQty = Qty
    
30.                         
    
31.                         Else
    
32.                            
    
33.                             Qty.Offset(, 1) = sheet2.Cells(1, Tagt.Column)
    
34.                             GoTo ntla
    
35.                         End If
    
36. ntxa:
    
37.                     Next Qty
    
38. ntla:
    
39.                 End With
    
40.             End If
    
41.             
    
42.         Next Tagt
    
43.    
    
44.     Next LotID
    
45. 
    
46. End With
    
47.    
    
48. End Sub

複製代碼

adam2010

感謝Dino大大迅速的協助，不過執行後
有部分數量被改到了，跟手動排的也有一些差異(如下圖綠底的部分是手排的結果)
小弟汗顏看不出是哪裡的問題？再次懇請協助，謝謝！

下載 (82.81 KB)
差異

2013-1-10 22:07

Hsieh

回復 3# adam2010


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

adam2010

感謝超級版主的提醒，應該是我描述得不夠清楚...
關於版主所提的問題~排程應該會考慮每批最大量或最小量是多少?
就以1/1的250來說，為何要排成2批100、200，不能排100、150嗎?
因為公司產品特性投料時是外購而來一根一根長短不一的晶棒，批量則是根據切的厚度計算出來的片數，會有上下限但是無法控制批量大小
而且有時候因為機台作業特性(一次要切兩段)，所以可能需求只有250但是投料的時候需要投2段就變成會有多的一批是暫時沒有交期的

因此以這個範例來看只能先將超過1/1需求量的批次A001~A002定交期為1/1，而A002剩下的50片則可以給1/5
然後1/5需要的300片就用A003....一直到最後一批因為前面的數量已經足夠所以就暫時沒有交期
物料B的則一樣因為1/5需求550，所以要有兩個批次才夠
另外就是訂單的出貨日是客戶給的數量以及需求的日期，所以並不會有一定的規則

不知道這樣的描述是不是比較清楚

adam2010

再補充一點就是有時候也會有
有訂單，但是尚未投料的狀況，所以只要將交期分配到同一個物料的批號結束即可

stillfish00

回復 6# adam2010
試試看

1. Sub Test()
   
2. Dim rng As Range
   
3. Dim s1 As Long, s2 As Long
   
4. Dim cindex As Long
   
5. 
   
6. With Sheets(2)
   
7.     Set rng = .Range(.[A1], .[A1].End(xlToRight).End(xlDown).Offset(, -1))  '[出貨日]資料範圍
   
8. End With
   
9. 
   
10. For Each c In Sheets(1).[E2:E15]    '[交期]資料填入範圍
    
11.     If c.Offset(, -4).Value <> c.Offset(-1, -4).Value Then
    
12.         cindex = 1
    
13.         s1 = 0  '累積至前一批數量
    
14.         s2 = 0  '累積出貨需求數量
    
15.     Else
    
16.         s1 = s1 + c.Offset(-1, -1).Value
    
17.     End If
    
18.    
    
19.     Do While s2 <= s1 And cindex < rng.Columns.Count
    
20.         cindex = cindex + 1
    
21.         s2 = s2 + Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)
    
22.     Loop
    
23.    
    
24.     If s2 <= s1 Then
    
25.         c.Value = "NA"
    
26.     Else
    
27.         c.Value = rng.Cells(1, cindex).Value
    
28.     End If
    
29. Next
    
30. Set rng=Nothing
    
31. End Sub

複製代碼

adam2010

太感動了!感謝stillfish00大大的協助，這裡真是高手如雲，每個都是大師級的
剛才試了 一下完全符合我的需求，不過套用到公司正式的大型檔案發現還有2個小問題
1.For Each c In Sheets(1).[E2:E15]    '[交期]資料填入範圍→如果範圍是變動的該如何修改
2.如果遇到交期裡面有但是出貨日沒有的物料就會因為找不到卡在21行→要如何增加一個判別讓找不到的也顯示NA
解決了這2個問題應該就很完美了

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

複製代碼

adam2010

Dear Hsieh大~感謝您出手相助
Sheets("交期")的D欄數量是公司報表篩出來的~
用公司的資料測試過之後Hsieh大的巨集解決了找不到會停止的問題，不過日期有些出入

下載 (131.85 KB)

2013-1-12 01:23

......汗顏找不出問題所在，所以再次求助，謝謝！
Test-1.rar (31.57 KB)

下載次數: 14

2013-1-12 01:23