[發問] 列出先進先出訊息

qaqa3296

各位大大

下載 (77.44 KB)

2020-3-29 21:13

我想列出有顏色的部分訊息

要依流水號依序跟庫存取資料，每筆資料會獨立計算並消耗庫存數

請各位大大給我點提示，感謝

ikboy

1. Sub zz()
   
2. Selection.Clear
   
3. Dim a, b(), r&, c&, n&, f$, t As Boolean
   
4. a = [a1].CurrentRegion
   
5. r = UBound(a) - 1
   
6. c = (UBound(a, 2) - 3) / 2
   
7. ReDim b(1 To r * c, 1 To 3)
   
8. t = True
   
9. For i = 2 To UBound(a)
   
10.     For j = 4 To UBound(a, 2) Step 2
    
11.         If IsDate(a(i, j)) Then
    
12.             If t Then f = Cells(i, j).NumberFormatLocal: t = false
    
13.             n = n + 1
    
14.             b(n, 1) = a(i, 2)
    
15.             b(n, 2) = a(i, j)
    
16.             b(n, 3) = a(i, j + 1)
    
17.         End If
    
18.     Next
    
19. Next
    
20. With Cells(2, UBound(a, 2) + 2)
    
21.     .Resize(n, 3) = b
    
22.     .Offset(0, 1).Resize(n).NumberFormatLocal = f
    
23.     .Resize(n, 3).Sort Cells(2, UBound(a, 2) + 2).Offset(0, 1)
    
24. End With
    
25. End Sub

複製代碼

qaqa3296

回復 2# ikboy

感謝這位大大回復

目前出現錯誤 執行階段錯誤'1004':

但是看不太懂這位大大的程式碼
不知是不是我敘述的不好，我想自動列出黃色區域訊息

流程是
需求的項目，依流水號順序去庫存找相同料件，如果有相同的料件則將他取出並顯示在黃色區域D2:E2再向下尋找相同料件資料往右2格再列出，直到滿足需求數量為止，如果數量不足則顯示不足
再依序流水號順序執行，但因為前面流水號的料件已將庫存數量取走，所以後面的需求很容易出現數量不足。

n7822123

回復 3# qaqa3296


先假定你的流水號從上到下都是由小到大

(如果流水號沒有規律且要按照流水號來決定出貨順序，會更燒腦.........)

試試看吧! 本來想用2個字典的，不過有什麼東西是1個字典還搞不定的呢?  

最多也只是資料長一點點.....................



Sub Ship()
Set D = CreateObject("Scripting.Dictionary")
Arr = Range([庫存!C2], [庫存!A5000].End(3))
For R = 1 To UBound(Arr)   '料件X：>日期1,庫存1>日期2,庫存2>日期３,庫存３...........
  D(Arr(R, 1)) = D(Arr(R, 1)) & ">" & Arr(R, 2) & "," & Arr(R, 3)
Next
Sheets("結果").Activate
For R = 2 To [A5000].End(3).Row
  Key$ = Cells(R, 2)
  LData = D(Key)
  If LData = "" Then
    Cells(R, 4) = "沒有資料"
    Cells(R, 5) = "數量不足"
    GoTo 下一流水號
  End If
  Data = Split(LData, ">")
  Ci = 4  'D欄開始填
  需求 = Cells(R, 3)
  For i = 1 To UBound(Data)
    日期 = Split(Data(i), ",")(0)
    庫存 = Split(Data(i), ",")(1)
    If 庫存 = 0 And i = UBound(Data) Then '最後一筆也是庫存0
      Cells(R, Ci) = "沒有資料"
      Cells(R, Ci + 1) = "數量不足"
      GoTo 下一流水號
    End If
    If 庫存 = 0 Then GoTo 下一庫存 '非最後一筆，庫存0
    If 庫存 - 需求 >= 0 Then
      Cells(R, Ci) = 日期
      Cells(R, Ci + 1) = 需求
      庫存 = 庫存 - 需求
      Data(i) = 日期 & "," & 庫存
      GoTo 已出貨完
    Else  '庫存 - 需求 <0
      Cells(R, Ci) = 日期
      Cells(R, Ci + 1) = 庫存
      需求 = 需求 - 庫存
      Ci = Ci + 2
      Data(i) = 日期 & "," & 0
      If i = UBound(Data) And 需求 > 0 Then  '最後一個庫存也無法滿足出貨
        Cells(R, Ci) = "沒有資料"
        Cells(R, Ci + 1) = "數量不足"
      End If
    End If
下一庫存:  Next i
已出貨完:  '(已經0庫存 或者 滿足出貨需求)
  LData = Join(Data, ">")
  D(Key) = LData
  Debug.Print Key & ":" & LData
下一流水號: Next R
End Sub

ikboy

回復 3# qaqa3296

Sorry, 多了第2行,請刪去再試。

qaqa3296

回復 4# n7822123

感謝 n7822123 大大的回復

這程式碼已達到需求

看起來淺顯易懂，正好可以學習一下

#也感謝ikboy大大的回復

刪除第二行依舊出現錯誤

執行階段錯誤'1004':

偵錯顯是在  .Resize(n, 3) = b 這行

但我看不懂ikboy大大的程式碼，所以無法自行除錯

准提部林

日期必須是由小而大排序的~~
程式碼簡化不了, 慢慢看吧!

1. Sub TEST()
   
2. Dim Arr, Brr, Crr, xD, i&, k%, R&, C%, 需求&, 庫存&, V&, TR, Mx&
   
3. Set xD = CreateObject("Scripting.Dictionary")
   
4. Arr = Range([庫存!C1], [庫存!A65536].End(xlUp))
   
5. For i = 2 To UBound(Arr)
   
6.     xD(Arr(i, 1)) = Trim(xD(Arr(i, 1)) & " " & i)
   
7. Next i
   
8. '---------------------------------
   
9. Brr = Range([C2], [B65536].End(xlUp))
   
10. ReDim Crr(1 To UBound(Brr), 1 To 100)
    
11. For i = 1 To UBound(Brr)
    
12.     C = 1:  需求 = Brr(i, 2)
    
13.     TR = Split(Trim(xD(Brr(i, 1)) & " 1"), " ")
    
14.     For k = 0 To UBound(TR)
    
15.         庫存 = Val(Arr(TR(k), 3)):   If 庫存 = 0 Then GoTo k01
    
16.         V = IIf(庫存 < 需求, 庫存, 需求)
    
17.         Crr(i, C) = CDate(Arr(TR(k), 2)):  Crr(i, C + 1) = V
    
18.         需求 = 需求 - V:   庫存 = 庫存 - V:   Arr(TR(k), 3) = 庫存
    
19.         C = C + 2
    
20. k01: Next k
    
21.      If 需求 > 0 Then Crr(i, C) = "沒有資料": Crr(i, C + 1) = "數量不足"
    
22. Next i
    
23. [D2].Resize(UBound(Crr), 100) = Crr
    
24. End Sub

複製代碼

Xl0000064.rar (14.91 KB)

下載次數: 8

2020-4-1 14:36

================================

准提部林

稍修一下, 若資料較多, 可減少不必要的迴圈:
Xl0000064-V2.rar (17.54 KB)

下載次數: 17

2020-4-2 10:07

qaqa3296

回復 8# 准提部林

感謝准提部林大大提供其他方式

能稍微解釋新增這兩行的邏輯嗎?

If 庫存 = 0 Then TR(k) = ""
xD(Brr(i, 1)) = Trim(Join(TR, " "))

准提部林

回復 9# qaqa3296

If 庫存 = 0 Then TR(k) = ""
_如果庫存=0, 將原有[行號]變成空字符

xD(Brr(i, 1)) = Trim(Join(TR, " "))
__Join(TR, " ") 重新將split的陣列以[空白字元]組成字串
__Trim(Join(TR, " "))...利用Trim去掉字串前後的空白字元, 變成新字串(字串會越來越短,甚至為空)