返回列表 上一主題 發帖

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

本帖最後由 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

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

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

TOP

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

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

  8. For Each c In Sheets("交期").Range("E2:E" & Sheets("交期").[A1].End(xlDown).Row)   '[交期]資料填入範圍
  9.     If c.Offset(, -4).Value <> c.Offset(-1, -4).Value Then
  10.         cindex = 1
  11.         s1 = 0  '累積至前一批數量
  12.         s2 = 0  '累積出貨需求數量
  13.     Else
  14.         s1 = s1 + c.Offset(-1, -1).Value
  15.     End If
  16.    
  17.     Do While s2 <= s1
  18.         cindex = cindex + 1
  19.         If Application.IsError(Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)) Then
  20.             Exit Do
  21.         Else
  22.             s2 = s2 + Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)
  23.         End If
  24.     Loop
  25.    
  26.     If s2 <= s1 Then
  27.         c.Value = "NA"
  28.     Else
  29.         c.Value = rng.Cells(1, cindex).Value
  30.     End If
  31. Next
  32. Set rng = Nothing
  33. End Sub
複製代碼

TOP

        靜思自在 : 有時當思無時苦,好天要積雨來糧。
返回列表 上一主題