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

adam2010

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

論壇贊助勳章
14#
發表於 2013-1-13 22:17 | 只看該作者
Dear  Hsieh大，感謝您的回覆，測試無誤
目前測試您跟stillfish00所提供的均正確，我再研究看看兩者的差異，謝謝！
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兔年全勤獎章
13#
發表於 2013-1-12 23:44 | 只看該作者
回復 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
複製代碼
學海無涯_不恥下問

TOP

adam2010

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

論壇贊助勳章
12#
發表於 2013-1-12 18:26 | 只看該作者
感謝Dino大,Hsieh大以及stillfish00大的協助，
測試無誤，解決我近幾週的困擾，太感動了，謝謝！
Adam

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
11#
發表於 2013-1-12 17:36 | 只看該作者
回復 8# 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("出貨日")
  7.     Set rng = .Range(.[A1], .[A1].End(xlToRight).End(xlDown).Offset(, -1))  '[出貨日]資料範圍
  8. End With

  10. For Each c In Sheets("交期").Range("E2:E" & Sheets("交期").[A1].End(xlDown).Row)   '[交期]資料填入範圍
  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
  20.         cindex = cindex + 1
  21.         If Application.IsError(Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)) Then
  22.             Exit Do
  23.         Else
  24.             s2 = s2 + Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)
  25.         End If
  26.     Loop
  27.    
  28.     If s2 <= s1 Then
  29.         c.Value = "NA"
  30.     Else
  31.         c.Value = rng.Cells(1, cindex).Value
  32.     End If
  33. Next
  34. Set rng = Nothing
  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

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 

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

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

TOP

        靜思自在 : 話多不如話少，話少不如話好。
12
返回列表 上一主題