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

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

論壇贊助勳章

14^#

發表於 2013-1-13 22:17 | 只看該作者

Dear Hsieh大，感謝您的回覆，測試無誤
目前測試您跟stillfish00所提供的均正確，我再研究看看兩者的差異，謝謝！

Adam

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

13^#

發表於 2013-1-12 23:44 | 只看該作者

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

Sub ex()
Dim Ar(), Ay(), C As Range, rng As Range
Set d = CreateObject("Scripting.Dictionary") '數量
Set d1 = CreateObject("Scripting.Dictionary") '日期
With Sheets("出貨日")
For Each a In .Range(.[A2], .[A2].End(xlDown)) '物料
Set rng = a.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers) '應交貨數量
For Each C In rng
cnt = cnt + C
ReDim Preserve Ar(s)
ReDim Preserve Ay(s)
Ar(s) = cnt
Ay(s) = .Cells(1, C.Column).Value
s = s + 1
Next
d(a.Value) = Ar
d1(a.Value) = Ay
Erase Ar: Erase Ay: s = 0: cnt = 0
Next
End With
With Sheets("交期")
For Each a In .Range(.[A2], .[A2].End(xlDown))
cnt = cnt + a.Offset(, 3)
If cnt <= Application.Max(d(a.Value)) Or cnt - a.Offset(, 3) < Application.Max(d(a.Value)) Then
i = 0
Do Until cnt - a.Offset(, 3) < d(a.Value)(i) Or i = UBound(d(a.Value)) '找到陣列中比已交貨數量還大的應交貨數量
n = d(a.Value)(i)
i = i + 1
Loop
a.Offset(, 4) = d1(a.Value)(i)
Else
a.Offset(, 4) = "NA"
End If
If a <> a.Offset(1) Then cnt = 0
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

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

論壇贊助勳章

12^#

發表於 2013-1-12 18:26 | 只看該作者

感謝Dino大,Hsieh大以及stillfish00大的協助，
測試無誤，解決我近幾週的困擾，太感動了，謝謝！

Adam

stillfish00

大學生 Rank: 4

帖子: 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

Sub Test()
Dim rng As Range
Dim s1 As Long, s2 As Long
Dim cindex As Long
With Sheets("出貨日")
Set rng = .Range(.[A1], .[A1].End(xlToRight).End(xlDown).Offset(, -1)) '[出貨日]資料範圍
End With
For Each c In Sheets("交期").Range("E2:E" & Sheets("交期").[A1].End(xlDown).Row) '[交期]資料填入範圍
If c.Offset(, -4).Value <> c.Offset(-1, -4).Value Then
cindex = 1
s1 = 0 '累積至前一批數量
s2 = 0 '累積出貨需求數量
Else
s1 = s1 + c.Offset(-1, -1).Value
End If
Do While s2 <= s1
cindex = cindex + 1
If Application.IsError(Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)) Then
Exit Do
Else
s2 = s2 + Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)
End If
Loop
If s2 <= s1 Then
c.Value = "NA"
Else
c.Value = rng.Cells(1, cindex).Value
End If
Next
Set rng = Nothing
End Sub

複製代碼

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

論壇贊助勳章

10^#

發表於 2013-1-12 01:26 | 只看該作者

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

......汗顏找不出問題所在，所以再次求助，謝謝！

Test-1.rar (31.57 KB)

Adam

Hsieh

超級版主 Rank: 8 Rank: 8

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

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欄數量是人工先輸入好的嗎?
試試看

Sub ex()
Dim Ar(), Ay(), C As Range, Rng As Range
Set d = CreateObject("Scripting.Dictionary") '數量
Set d1 = CreateObject("Scripting.Dictionary") '日期
With Sheets("出貨日")
For Each a In .Range(.[A2], .[A2].End(xlDown)) '物料
Set Rng = a.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers) '訂貨
ReDim Preserve Ar(s) '數量
ReDim Preserve Ay(s) '日期
Ar(s) = 0
Ay(s) = .Cells(1, Rng.Column)
s = s + 1
For Each C In Rng
cnt = cnt + C
ReDim Preserve Ar(s)
ReDim Preserve Ay(s)
Ar(s) = cnt
Ay(s) = .Cells(1, C.Column).Value
s = s + 1
Next
d(a.Value) = Ar
d1(a.Value) = Ay
Erase Ar: Erase Ay: s = 0: cnt = 0
Next
End With
With Sheets("交期")
For Each a In .Range(.[A2], .[A2].End(xlDown))
cnt = cnt + a.Offset(, 3)
If cnt <= Application.Max(d(a.Value)) Or cnt - a.Offset(, 3) < Application.Max(d(a.Value)) Then _
a.Offset(, 4) = Application.Lookup(cnt, d(a.Value), d1(a.Value)) _
Else a.Offset(, 4) = "NA"
If a <> a.Offset(1) Then cnt = 0
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

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

論壇贊助勳章

8^#

發表於 2013-1-11 22:44 | 只看該作者

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

Adam

stillfish00

大學生 Rank: 4

帖子: 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
試試看

Sub Test()
Dim rng As Range
Dim s1 As Long, s2 As Long
Dim cindex As Long
With Sheets(2)
Set rng = .Range(.[A1], .[A1].End(xlToRight).End(xlDown).Offset(, -1)) '[出貨日]資料範圍
End With
For Each c In Sheets(1).[E2:E15] '[交期]資料填入範圍
If c.Offset(, -4).Value <> c.Offset(-1, -4).Value Then
cindex = 1
s1 = 0 '累積至前一批數量
s2 = 0 '累積出貨需求數量
Else
s1 = s1 + c.Offset(-1, -1).Value
End If
Do While s2 <= s1 And cindex < rng.Columns.Count
cindex = cindex + 1
s2 = s2 + Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)
Loop
If s2 <= s1 Then
c.Value = "NA"
Else
c.Value = rng.Cells(1, cindex).Value
End If
Next
Set rng=Nothing
End Sub

複製代碼

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

論壇贊助勳章

6^#

發表於 2013-1-11 00:31 | 只看該作者

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

Adam