stillfish00

回復 8# 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("出貨日")
   
7.     Set rng = .Range(.[A1], .[A1].End(xlToRight).End(xlDown).Offset(, -1))  '[出貨日]資料範圍
   
8. End With
   
9. 
   
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

複製代碼

adam2010

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

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

複製代碼

adam2010

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