[發問] 一個料號對應多個DateCode及數量

jsc0518

Dear 先進,
工作表List為最終產生之報表
工作表eb為資料庫(預計資料庫約有100,000左右)

工作表List的A欄列為料號，而每一筆料號會有不同的DateCode，而每一筆DateCode都有對應的庫存數量
想要呈現畫面如下：

下載 (44.22 KB)

2022-12-16 21:57

D欄~M欄的部分，要運用哪一函數才可以做到上述圖片中的狀況呢？

下圖為資料庫(工作表eb)畫面

下載 (54.78 KB)

2022-12-16 21:57

找批號數量.rar (7.89 KB)

下載次數: 6

2022-12-16 22:00

還請各位先進指導解惑！謝謝大家！

Andy2483

回復 1# jsc0518


    謝謝前輩發表此主題與範例
後學研究過一帖,有點類似,連結如下供參考:
http://forum.twbts.com/viewthrea ... E%E3%B2z&page=1

Andy2483

回復 1# jsc0518


    謝謝前輩發表此主題與範例
後學藉此帖學習到很多知識與經驗,練習字典與陣列,初次練習輔助表排序
以下學習結果請前輩試試看,謝謝

執行前:

下載 (74.98 KB)

2022-12-20 16:22

執行結果:

下載 (51.63 KB)

2022-12-20 16:16

Option Explicit
Sub TEST_20221220()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Arr, i&, j&, T1$, T3&, T6$, W, X, Y, Z, C, R, m, N, S
Set X = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
Set W = CreateObject("Scripting.Dictionary")
Arr = Range([eb!F2], [eb!A1].Cells(Rows.Count, 1).End(xlUp))
For i = 1 To UBound(Arr)
   If W(Arr(i, 1)) = Empty Then
      S = S + 1
      W(Arr(i, 1)) = S
      Arr(i, 2) = S
      Else
         Arr(i, 2) = W(Arr(i, 1))
   End If
Next
With Sheets.Add
   With .[A1].Resize(UBound(Arr), UBound(Arr, 2))
      .Value = Arr
      .Sort _
      KEY1:=.Item(2), Order1:=xlAscending, _
      Key2:=.Item(6), Order2:=xlAscending, _
      Header:=xlNo, Orientation:=xlTopToBottom
       Arr = .Value
   End With
   .Delete
End With
For i = 1 To UBound(Arr)
   T1 = Arr(i, 1)
   T3 = Arr(i, 3)
   T6 = Arr(i, 6)
   If X(T1 & "|" & T6) = Empty Then
      Y(T1) = Y(T1) + 1
      X(T1 & "|" & T6) = Y(T1)
      If Y(T1) > m Then m = Y(T1)
   End If
   W(T1 & "|" & T6) = W(T1 & "|" & T6) + T3
Next
ReDim Arr(1 To Y.Count, 1 To m + 3)
For Each R In Y.KEYS
   N = N + 1
   Arr(N, 1) = "'" & R
   Y(R) = N
Next
For Each C In X.KEYS
   Arr(Y(Split(C, "|")(0)), X(C) + 3) = Split(C, "|")(1) & "/" & W(C)
Next
Sheets("List").UsedRange.Offset(1, 0).Clear
With [List!A2].Resize(UBound(Arr), UBound(Arr, 2))
    .Value = Arr
End With
Set X = Nothing
Set Y = Nothing
Set Z = Nothing
Set Arr = Nothing
End Sub

jsc0518

回復 3# Andy2483
Dear Andy,
您真厲害，這VBA語法可以使用歐，感恩感恩！
:)

Andy2483

回復 4# jsc0518


    謝謝前輩回復
今天再複習了一下,邏輯更清楚,也發現一些缺漏與贅述
以下是心得註解,請前輩參考,也請各位前輩指導,謝謝

Option Explicit
Sub TEST_20221220()
Application.DisplayAlerts = False
'↑執行過程不要跳出(問工作表是不是確定要刪除?)視窗
'https://learn.microsoft.com/zh-tw/office/vba/api/excel.application.displayalerts
Application.ScreenUpdating = False
'↑螢幕不隨著程式執行變化結果
Dim i&, T3&, m&, N&, T1$, T6$, Arr, W, X, Y, Z, C, R, S
'↑宣告變數:(i,T3,m,N)是長整數變數,(T1,T6)是字串變數,其他的是通用型變數
Set X = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
Set W = CreateObject("Scripting.Dictionary")
'↑令X,Y,Z 各是 字典
Arr = Range([eb!F2], [eb!A1].Cells(Rows.Count, 1).End(xlUp))
'↑令Arr是二維陣列!倒入從eb表[F2]到eb表A欄最後一個有內容儲存格,
'擴展出最小方正區域儲存格的值
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1到Arr陣列縱向最大索引列號
   If W(Arr(i, 1)) = Empty Then
   '↑如果以i迴圈列第1欄的Arr陣列值查W字典是沒有這key??
      S = S + 1
      '↑if條件成立!就讓S累加1
      W(Arr(i, 1)) = S
      '↑令i迴圈列第1欄的Arr陣列值當key,Item是 S變數
      Arr(i, 2) = S
      '↑令i迴圈列第2欄的Arr陣列值也是 S變數
      Else
      '↑以下是if條件不成立才執行的
         Arr(i, 2) = W(Arr(i, 1))
         '↑令i迴圈列第2欄的Arr陣列值是 以i迴圈列第1欄的Arr陣列值查W字典得到的item值
   End If
Next
With Sheets.Add
'↑以下是關於新增一個工作表的程序
   With .[A1].Resize(UBound(Arr), UBound(Arr, 2))
   '↑以下是關於新增工作表裡[A1]向下擴展 Arr陣列縱向最大索引列號數,
   '向右擴展 Arr陣列橫向向最大索引欄號數,這方正範圍儲存格的程序
      .Value = Arr
      '↑令這範圍儲存格值 以Arr陣列值倒入
      .Sort _
      KEY1:=.Item(2), Order1:=xlAscending, _
      Key2:=.Item(6), Order2:=xlAscending, _
      Header:=xlNo, Orientation:=xlTopToBottom
      '↑令以第2欄做第一層做沒有標列的上下順排序,第6欄同時做第二層上下順排序
      Arr = .Value
      '↑令Arr陣列倒掉原來的值,裝入這排序好的儲存格值
   End With
   .Delete
   '↑令這新增工作表刪除
End With
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1到 Arr陣列縱向最大索引列號數
   T1 = Arr(i, 1)
   '↑令T1這字串變數是 i迴圈列第1欄的Arr陣列值
   T3 = Arr(i, 3)
   '↑令T3這長整數變數是 i迴圈列第3欄的Arr陣列值
   T6 = Arr(i, 6)
   '↑令T6這字串變數是 i迴圈列第6欄的Arr陣列值
   If X(T1 & "|" & T6) = Empty Then
   '↑如果以 T1字串變數連接 "|" 符號,再連接T6字串變數 的新字串查W字典! 是沒有這key??
      Y(T1) = Y(T1) + 1
      '↑令以 T1字串變數當key,Item是自己 +1 放到字典裡或提出來+1再放回去
      X(T1 & "|" & T6) = Y(T1)
      '↑令以 T1字串變數連接 "|" 符號,再連接T6字串變數 的新字串當key,item是 Y(T1) 放到字典裡
      If Y(T1) > m Then m = Y(T1)
      '↑如果以 T1字串變數查Y字典的item值是 大於 m這長整數變數,
      '就讓m帶入 T1字串變數查Y字典的item值
   End If
   W(T1 & "|" & T6) = W(T1 & "|" & T6) + T3
   '↑令T1字串變數連接 "|" 符號,再連接T6字串變數 的新字串當key,
   'Item是自己 + T3這長整數變數 放到字典裡或提出來+1再放回去
Next
ReDim Arr(1 To Y.Count, 1 To m + 3)
'↑宣告Arr陣列的範圍!縱向從1到Y字典裡key的數量,橫向從1到 m長整數變數+3
For Each R In Y.KEYS
'↑設順迴圈!令R這通用型變數是 Y字典裡的key,從前面輪到最後面
   N = N + 1
   '↑令N這長整數變數累加 1
   Arr(N, 1) = "'" & R
   '↑令N長整數變數列第1欄Arr陣列值是 "'"符號連接R迴圈key值
   Y(R) = N
   '↑令R迴圈key值當Y陣列的key,item是N長整數變數
Next
For Each C In X.KEYS
'↑設順迴圈!令C這通用型變數是 X字典裡的key,從前面輪到最後面
   Arr(Y(Split(C, "|")(0)), X(C) + 3) = Split(C, "|")(1) & "/" & W(C)
   '↑令Arr陣列 (C迴圈key值以"|"符號分割成一維陣列後 取索引號0的陣列值 當key查Y字典得item值)列,
   '(C迴圈key值 當key查Y字典得item值+3)欄 的值是,
   'C迴圈key值以"|"符號分割成一維陣列後取索引號1的陣列值連接 "/"符號,
   '再連接 以C迴圈key值查W字典的item值
Next
Sheets("List").UsedRange.Offset(1, 0).Clear
'↑令"List"工作表有使用的儲存格擴展最小方正區域再往下偏移一列的區域儲存格 清除
[List!A2].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
'↑令"List"工作表[A2]往下擴展 Arr陣列縱向最大索引列號數,
'往右擴展Arr陣列橫向最大索引欄號數這方正區域的儲存格值是 Arr陣列值
Set X = Nothing
Set Y = Nothing
Set Z = Nothing
Set Arr = Nothing
'↑令這些變數釋放
End Sub

hcm19522

https://blog.xuite.net/hcm19522/twblog/590662480

Andy2483

回復 6# hcm19522


    前輩厲害,一行公式可以取代後學想破頭的VBA
前輩可以撥空簡單提點一下創立這一長串公式的思路嗎?
謝謝前輩

jsc0518

回復 6# hcm19522
感謝hcm19522的熱心回復，沒想到Excel公式還是可以帶出特殊條件需求。
感謝您提供的解答，謝謝您！:)