12
返回列表 上一主題 發帖

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

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2024-10-10 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-1-10 01:09 | 只看該作者

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

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

拆開到各子批的交期

如說明

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

dino1978

帖子
38 
主題
4 
精華
0 
積分
65 
點名
0  
作業系統
Window7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
來自
Taipei 
註冊時間
2011-12-16 
最後登錄
2013-12-13 
2#
發表於 2013-1-10 14:18 | 只看該作者
回復 1# adam2010


    試試看吧
  1. Private Sub CommandButton1_Click()

  3. Dim LotID As Range, Tagt As Range, Qty As Range
  4. Dim a, TalQty

  6. With sheet2

  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

  46. End With
  47.    
  48. End Sub
複製代碼

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2024-10-10 

論壇贊助勳章
3#
發表於 2013-1-10 22:10 | 只看該作者
感謝Dino大大迅速的協助，不過執行後
有部分數量被改到了，跟手動排的也有一些差異(如下圖綠底的部分是手排的結果)
小弟汗顏看不出是哪裡的問題？再次懇請協助，謝謝！

差異.jpg (159.89 KB)

差異.jpg

Adam

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
247  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-14 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2013-1-10 22:45 | 只看該作者
回復 3# adam2010


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

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2024-10-10 

論壇贊助勳章
5#
發表於 2013-1-11 00:20 | 只看該作者
感謝超級版主的提醒，應該是我描述得不夠清楚...
關於版主所提的問題~排程應該會考慮每批最大量或最小量是多少?
就以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，所以要有兩個批次才夠
另外就是訂單的出貨日是客戶給的數量以及需求的日期，所以並不會有一定的規則

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

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2024-10-10 

論壇贊助勳章
6#
發表於 2013-1-11 00:31 | 只看該作者
再補充一點就是有時候也會有
有訂單，但是尚未投料的狀況，所以只要將交期分配到同一個物料的批號結束即可
Adam

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
7#
發表於 2013-1-11 14:14 | 只看該作者
本帖最後由 stillfish00 於 2013-1-11 14:15 編輯

回復 6# adam2010
試試看
  1. Sub Test()
  2. Dim rng As Range
  3. Dim s1 As Long, s2 As Long
  4. Dim cindex As Long

  6. With Sheets(2)
  7.     Set rng = .Range(.[A1], .[A1].End(xlToRight).End(xlDown).Offset(, -1))  '[出貨日]資料範圍
  8. End With

  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
複製代碼

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2024-10-10 

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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
247  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-14 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2013-1-12 00:06 | 只看該作者
本帖最後由 Hsieh 於 2013-1-12 00:10 編輯

回復 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
複製代碼
學海無涯_不恥下問

TOP

adam2010

帖子
145 
主題
42 
精華
0 
積分
193 
點名
0  
作業系統
Windows7 
軟體版本
Office2010 
閱讀權限
20 
性別
男 
註冊時間
2010-11-25 
最後登錄
2024-10-10 

論壇贊助勳章
10#
發表於 2013-1-12 01:26 | 只看該作者
Dear Hsieh大~感謝您出手相助
Sheets("交期")的D欄數量是公司報表篩出來的~
用公司的資料測試過之後Hsieh大的巨集解決了找不到會停止的問題，不過日期有些出入

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

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
12
返回列表 上一主題