12
返回列表 上一主題 發帖

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

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2024-11-23 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-3-29 21:22 | 只看該作者

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

各位大大


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

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

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

test.zip (10.14 KB)

收藏 分享

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
17  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-11-19 

2016猴年全勤獎章
2#
發表於 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
複製代碼

TOP

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2024-11-23 
3#
發表於 2020-3-30 21:23 | 只看該作者
回復 2# ikboy

感謝這位大大回復

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

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

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

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
4#
發表於 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
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
17  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-11-19 

2016猴年全勤獎章
5#
發表於 2020-3-31 08:45 | 只看該作者
回復 3# qaqa3296

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

TOP

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2024-11-23 
6#
發表於 2020-3-31 22:38 | 只看該作者
回復 4# n7822123

感謝 n7822123 大大的回復

這程式碼已達到需求

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

#也感謝ikboy大大的回復

刪除第二行依舊出現錯誤

執行階段錯誤'1004':

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

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

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-26 
7#
發表於 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
複製代碼
Xl0000064.rar (14.91 KB)


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

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-26 
8#
發表於 2020-4-2 10:08 | 只看該作者
稍修一下, 若資料較多, 可減少不必要的迴圈:
Xl0000064-V2.rar (17.54 KB)

TOP

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2024-11-23 
9#
發表於 2020-4-2 20:31 | 只看該作者
回復 8# 准提部林

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

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

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

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-26 
10#
發表於 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去掉字串前後的空白字元, 變成新字串(字串會越來越短,甚至為空)

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
12
返回列表 上一主題