Board logo

標題: [發問] 列出先進先出訊息 [打印本頁]
作者: qaqa3296    時間: 2020-3-29 21:22     標題: 列出先進先出訊息

各位大大
[attach]31827[/attach]

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

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

請各位大大給我點提示，感謝
作者: ikboy    時間: 2020-3-30 10:58

  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    時間: 2020-3-30 21:23

回復 2# ikboy

感謝這位大大回復

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

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

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

本帖最後由 n7822123 於 2020-3-31 00:47 編輯

回復 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    時間: 2020-3-31 08:45

回復 3# qaqa3296

Sorry, 多了第2行,請刪去再試。
作者: qaqa3296    時間: 2020-3-31 22:38

回復 4# n7822123

感謝 n7822123 大大的回復

這程式碼已達到需求

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

#也感謝ikboy大大的回復

刪除第二行依舊出現錯誤

執行階段錯誤'1004':

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

但我看不懂ikboy大大的程式碼，所以無法自行除錯
作者: 准提部林    時間: 2020-4-1 14:36

日期必須是由小而大排序的~~
程式碼簡化不了, 慢慢看吧!
  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
複製代碼
[attach]31846[/attach]


================================
作者: 准提部林    時間: 2020-4-2 10:08

稍修一下, 若資料較多, 可減少不必要的迴圈:
[attach]31850[/attach]
作者: qaqa3296    時間: 2020-4-2 20:31

回復 8# 准提部林

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

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

If 庫存 = 0 Then TR(k) = ""
xD(Brr(i, 1)) = Trim(Join(TR, " "))
作者: 准提部林    時間: 2020-4-3 10:43

回復 9# qaqa3296

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

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

本帖最後由 n7822123 於 2020-4-4 05:19 編輯

回復 4# n7822123


看了準大寫的程式，我發現，我寫的還真是冗長.......

我也要學學只用字典紀錄列號，而不是把資料一股腦的塞進字典XD

不過準大用了不少小技巧，要讀懂可能比較難一點點

(如回讀第一列資料，用 val 函數把純字串變成數字0)

作者: 准提部林    時間: 2020-4-4 09:44

回復 11# n7822123


因對excel公式有些經驗, 所以程式碼中摻入了公式技巧,
雖然看起來短, 但效率及易讀性不一定就比較好!
其實程式碼最好是效率兼顧易讀性, 利于以後的修改。

因將變數定義為整數, 所以用val(???) 來避錯,
也可少一次IF的判斷~~ IF ISNUMERIC(ARR(I,3)) THEN
作者: hcm19522    時間: 2020-4-25 10:43

本帖最後由 hcm19522 於 2024-1-31 17:10 編輯

(輸入編號10769-1) google網址:https://draft.blogger.com/blog/posts/9094075214774179359
作者: Andy2483    時間: 2024-1-31 16:35

回復 8# 准提部林


    謝謝論壇,謝謝前輩指導
後學藉此帖練習陣列與字典,學習方案如下,請前輩再指導

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, 需求&, Z, i&, j%, C%, T$, 庫存&, D As Date, W&, V&, R&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([庫存!C1], [庫存!A65536].End(3))
For i = 2 To UBound(Brr)
   T = Trim(Brr(i, 1)): If T = "" Then GoTo i01
   If Not IsObject(Z(T)) Then Set Z(T) = CreateObject("Scripting.Dictionary")
   Z(T)(i) = 0: Z(T & "Tot") = Z(T & "Tot") + Val(Brr(i, 3))
i01: Next
Crr = Range([原始!C1], [原始!A65536].End(3))
ReDim Arr(2 To UBound(Crr), 1 To 100)
For i = 2 To UBound(Crr)
   T = Trim(Crr(i, 2)): 需求 = Val(Crr(i, 3)): C = 0: If Z(T & "Tot") = 0 Then GoTo i02
   For j = Z(T & "No") To Z(T).Count - 1
      W = W + 1: R = Z(Trim(Crr(i, 2))).keys()(j)
      庫存 = Val(Brr(R, 3))
      D = CDate(Brr(Z(Trim(Crr(i, 2))).keys()(j), 2))
      V = IIf(庫存 < 需求, 庫存, 需求)
      Arr(i, C + 1) = D: Arr(i, C + 2) = V: C = C + 2
      Z(T & "Tot") = Z(T & "Tot") - V
      需求 = 需求 - V: 庫存 = 庫存 - V
      If 庫存 = 0 Then Z(T & "No") = Z(T & "No") + 1 Else Brr(R, 3) = 庫存
      If 需求 = 0 Then Exit For
   Next
i02: If Z(T & "Tot") = 0 And 需求 > 0 Then Arr(i, C + 1) = "沒有資料": Arr(i, C + 2) = "數量不足"
Next
[原始!D2].Resize(UBound(Arr) - 1, UBound(Arr, 2)) = Arr
MsgBox "迴圈數:" & W
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)